From fe078ee54bb808fbec065e67596051cf0fc856ba Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Fri, 6 Feb 2009 23:23:21 +0000
Subject: [PATCH] stuffers

svn: r13474
---
 .../tests/web-server/all-web-server-tests.ss  |   2 +
 .../tests/web-server/lang/stuff-url-test.ss   |   3 +-
 collects/tests/web-server/stuffers-test.ss    | 103 +++++++++
 .../htdocs/lang-servlets/add04-stuffer.ss     |  34 +++
 collects/web-server/lang/lang-api.ss          |   2 +
 collects/web-server/lang/stuff-url.ss         | 152 +++-----------
 collects/web-server/lang/web.ss               |  26 +--
 collects/web-server/private/md5-store.ss      |  22 --
 collects/web-server/private/servlet.ss        |   3 +-
 .../scribblings/dummy-stateless-servlet.ss    |   1 +
 collects/web-server/scribblings/lang.scrbl    |  54 +----
 .../web-server/scribblings/servlet-env.scrbl  |  10 +-
 .../scribblings/stateless-servlet.scrbl       |  14 +-
 .../web-server/scribblings/stuffers.scrbl     | 196 ++++++++++++++++++
 collects/web-server/scribblings/writing.scrbl |   2 +
 collects/web-server/servlet-env.ss            |  11 +-
 collects/web-server/servlet/setup.ss          |  22 +-
 collects/web-server/stuffers.ss               |  19 ++
 collects/web-server/stuffers/base64.ss        |   9 +
 collects/web-server/stuffers/gzip.ss          |   9 +
 collects/web-server/stuffers/hash.ss          |  24 +++
 collects/web-server/stuffers/serialize.ss     |  13 ++
 collects/web-server/stuffers/store.ss         |  20 ++
 collects/web-server/stuffers/stuffer.ss       |  80 +++++++
 24 files changed, 606 insertions(+), 225 deletions(-)
 create mode 100644 collects/tests/web-server/stuffers-test.ss
 create mode 100644 collects/web-server/default-web-root/htdocs/lang-servlets/add04-stuffer.ss
 delete mode 100644 collects/web-server/private/md5-store.ss
 create mode 100644 collects/web-server/scribblings/stuffers.scrbl
 create mode 100644 collects/web-server/stuffers.ss
 create mode 100644 collects/web-server/stuffers/base64.ss
 create mode 100644 collects/web-server/stuffers/gzip.ss
 create mode 100644 collects/web-server/stuffers/hash.ss
 create mode 100644 collects/web-server/stuffers/serialize.ss
 create mode 100644 collects/web-server/stuffers/store.ss
 create mode 100644 collects/web-server/stuffers/stuffer.ss

diff --git a/collects/tests/web-server/all-web-server-tests.ss b/collects/tests/web-server/all-web-server-tests.ss
index 3856463b75..cf1831aa22 100644
--- a/collects/tests/web-server/all-web-server-tests.ss
+++ b/collects/tests/web-server/all-web-server-tests.ss
@@ -8,6 +8,7 @@
          "http/all-http-tests.ss"
          "private/all-private-tests.ss"
          "servlet/all-servlet-tests.ss"
+         "stuffers-test.ss"
          "servlet-env-test.ss")
 (provide all-web-server-tests)
 
@@ -15,6 +16,7 @@
   (test-suite
    "Web Server"
    all-http-tests
+   all-stuffers-tests
    all-configuration-tests
    all-dispatchers-tests
    all-lang-tests
diff --git a/collects/tests/web-server/lang/stuff-url-test.ss b/collects/tests/web-server/lang/stuff-url-test.ss
index b2c8fcb86c..0f936bd836 100644
--- a/collects/tests/web-server/lang/stuff-url-test.ss
+++ b/collects/tests/web-server/lang/stuff-url-test.ss
@@ -1,12 +1,13 @@
 #lang scheme/base
 (require web-server/lang/stuff-url
+         web-server/stuffers
          (planet "test.ss" ("schematics" "schemeunit.plt" 2))
          net/url
          mzlib/serialize
          "../util.ss")
 (provide stuff-url-tests)
 
-(define uri0 (string->url "www.google.com"))  
+(define uri0 (string->url "www.google.com")) 
 
 (define test-stuffer serialize-stuffer)
 
diff --git a/collects/tests/web-server/stuffers-test.ss b/collects/tests/web-server/stuffers-test.ss
new file mode 100644
index 0000000000..3abd445dec
--- /dev/null
+++ b/collects/tests/web-server/stuffers-test.ss
@@ -0,0 +1,103 @@
+#lang scheme
+(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
+         web-server/stuffers
+         web-server/private/servlet
+         web-server/http
+         net/url
+         scheme/serialize)
+(provide all-stuffers-tests)
+
+(define (stuffer-test s)
+  (define x (string->bytes/utf-8 (number->string (random 1000))))
+  (check-equal? ((stuffer-out s) ((stuffer-in s) x))
+                x))
+
+(define (store-test s)
+  (define x (string->bytes/utf-8 (number->string (random 1000))))
+  (define y (string->bytes/utf-8 (number->string (random 1000))))
+  (check-equal? (begin ((store-write s) x y)
+                       ((store-read s) x))
+                y))
+
+(define prep-stuffer
+  (make-stuffer
+   (lambda (v) (bytes-append #"20" v))
+   (lambda (v) (subbytes v 2))))
+
+(define (context-wrap thnk)
+  (parameterize ([current-execution-context
+                               (make-execution-context 
+                                (make-request #"GET" (string->url "http://www.google.com") 
+                                              empty empty
+                                              #"" "127.0.0.1" 80
+                                              "127.0.0.1"))])
+    (thnk)))
+
+(define all-stuffers-tests
+  (test-suite
+   "Stuffers"
+   
+   (test-suite "stuffer"
+               (test-case "id-stuffer" (stuffer-test id-stuffer))
+               
+               (test-case "stuffer-compose" (stuffer-test (stuffer-compose id-stuffer id-stuffer)))
+               (test-case "stuffer-compose" (stuffer-test (stuffer-compose prep-stuffer id-stuffer)))
+               (test-case "stuffer-compose" (stuffer-test (stuffer-compose id-stuffer prep-stuffer)))
+               (test-case "stuffer-compose" (stuffer-test (stuffer-compose prep-stuffer prep-stuffer)))
+               
+               (test-case "stuffer-sequence" (stuffer-test (stuffer-sequence id-stuffer id-stuffer)))
+               (test-case "stuffer-sequence" (stuffer-test (stuffer-sequence prep-stuffer id-stuffer)))
+               (test-case "stuffer-sequence" (stuffer-test (stuffer-sequence id-stuffer prep-stuffer)))
+               (test-case "stuffer-sequence" (stuffer-test (stuffer-sequence prep-stuffer prep-stuffer)))
+               
+               (test-case "stuffer-if" (stuffer-test (stuffer-if (lambda (v) #t) id-stuffer)))
+               (test-case "stuffer-if" (stuffer-test (stuffer-if (lambda (v) #f) id-stuffer)))
+               (test-case "stuffer-if" (stuffer-test (stuffer-if (lambda (v) #t) prep-stuffer)))
+               (test-case "stuffer-if" (stuffer-test (stuffer-if (lambda (v) #f) prep-stuffer)))
+               
+               (test-case "stuffer-chain" (stuffer-test (stuffer-chain)))
+               (test-case "stuffer-chain" (stuffer-test (stuffer-chain (lambda (v) #f))))
+               (test-case "stuffer-chain" (stuffer-test (stuffer-chain (lambda (v) #f) prep-stuffer)))
+               (test-case "stuffer-chain" (stuffer-test (stuffer-chain prep-stuffer (lambda (v) #f) prep-stuffer))))
+   
+   (test-suite "base64"
+               (test-case "base64-stuffer" (stuffer-test base64-stuffer)))
+   
+   (test-suite "gzip"
+               (test-case "gzip-stuffer" (stuffer-test gzip-stuffer)))
+   
+   (test-suite "serialize"
+               (test-case "serialize-stuffer" (stuffer-test serialize-stuffer)))
+   
+   (test-suite "store"
+               (test-case "dir-store" (store-test (dir-store (find-system-path 'temp-dir)))))
+   
+   (test-suite "hash"
+               (test-case "md5-stuffer" (stuffer-test (md5-stuffer (find-system-path 'temp-dir)))))
+   
+   (test-suite "stuff-url"
+               (test-case "make-default-stuffer"
+                          (context-wrap 
+                           (lambda () 
+                             (stuffer-test (make-default-stuffer (find-system-path 'temp-dir))))))
+               
+               (test-case "is-url-too-big?"
+                          (context-wrap
+                           (lambda ()
+                             (check-false (is-url-too-big? (make-bytes 1 65))))))
+               (test-case "is-url-too-big?"
+                          (context-wrap
+                           (lambda ()
+                             (check-false (is-url-too-big? (make-bytes 10 65))))))
+               (test-case "is-url-too-big?"
+                          (context-wrap
+                           (lambda ()
+                             (check-false (is-url-too-big? (make-bytes 100 65))))))
+               (test-case "is-url-too-big?"
+                          (context-wrap
+                           (lambda ()
+                             (check-false (is-url-too-big? (make-bytes 1000 65))))))
+               (test-case "is-url-too-big?"
+                          (context-wrap
+                           (lambda ()
+                             (check-not-false (is-url-too-big? (make-bytes 3000 65)))))))))
\ No newline at end of file
diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add04-stuffer.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add04-stuffer.ss
new file mode 100644
index 0000000000..6c6629baaf
--- /dev/null
+++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add04-stuffer.ss
@@ -0,0 +1,34 @@
+#lang web-server
+(define interface-version 'stateless)
+(define stuffer
+  (stuffer-chain
+   serialize-stuffer
+   (md5-stuffer (build-path (find-system-path 'home-dir) ".urls"))))
+(provide start interface-version stuffer)
+
+;; get-number-from-user: string -> number
+;; ask the user for a number
+(define (gn msg)
+  (let ([req
+         (send/suspend/url
+          (lambda (k-url)
+            `(hmtl (head (title ,(format "Get ~a number" msg)))
+                   (body
+                    (form ([action ,(url->string k-url)]
+                           [method "post"]
+                           [enctype "application/x-www-form-urlencoded"])
+                          ,(format "Enter the ~a number to add: " msg)
+                          (input ([type "text"] [name "number"] [value ""]))
+                          (input ([type "submit"])))))))])
+    (string->number
+     (bytes->string/utf-8
+      (binding:form-value
+       (bindings-assq #"number" 
+                      (request-bindings/raw req)))))))
+
+(define (start initial-request)
+  `(html (head (title "Final Page"))
+         (body
+          (h1 "Final Page")
+          (p ,(format "The answer is ~a"
+                      (+ (gn "first") (gn "second")))))))
diff --git a/collects/web-server/lang/lang-api.ss b/collects/web-server/lang/lang-api.ss
index 6a301544b0..9c2282f84b 100644
--- a/collects/web-server/lang/lang-api.ss
+++ b/collects/web-server/lang/lang-api.ss
@@ -1,6 +1,7 @@
 #lang scheme
 (require net/url
          web-server/http
+         web-server/stuffers
          web-server/lang/abort-resume
          web-server/lang/web
          web-server/lang/web-cells
@@ -9,6 +10,7 @@
 (provide (except-out (all-from-out scheme) #%module-begin)
          (all-from-out net/url
                        web-server/http
+                       web-server/stuffers
                        web-server/lang/abort-resume
                        web-server/lang/web
                        web-server/lang/web-cells
diff --git a/collects/web-server/lang/stuff-url.ss b/collects/web-server/lang/stuff-url.ss
index 5693cf61d4..1600745e2e 100644
--- a/collects/web-server/lang/stuff-url.ss
+++ b/collects/web-server/lang/stuff-url.ss
@@ -1,110 +1,27 @@
 #lang scheme
 (require net/url
          scheme/serialize
-         web-server/private/md5-store
-         web-server/private/gzip
          web-server/private/servlet
+         web-server/stuffers/stuffer
+         web-server/stuffers/serialize
+         web-server/stuffers/gzip
+         web-server/stuffers/base64
+         web-server/stuffers/hash
          web-server/http
-         "../private/util.ss"
-         "../private/url-param.ss"
-         "../private/mod-map.ss")
-
-;; NEW
-; A stuffer is
-;  - in  : any -> bytes
-;  - out : bytes -> any
-; such that
-;  out (in x) = x
-;  in (out x) = x
-(define-struct stuffer (in out))
-
-(define id-stuffer
-  (make-stuffer 
-   (lambda (v) v)
-   (lambda (v) v)))
-
-(define serialize-stuffer
-  (make-stuffer
-   (lambda (v) (write/bytes (compress-serial (serialize v))))
-   (lambda (v) (deserialize (decompress-serial (read/bytes v))))))
-
-(define gzip-stuffer
-  (make-stuffer gzip/bytes gunzip/bytes))
-
-(require net/base64)
-(define base64-stuffer
-  (make-stuffer base64-encode base64-decode))
-
-(define-struct store (write read))
-(define (dir-store home)
-  (make-store
-   (lambda (key value)
-     (with-output-to-file
-         (build-path home (format "~a" key))
-       (lambda ()
-         (write value))
-       #:exists 'replace))
-   (lambda (key)
-     (with-input-from-file
-         (build-path home (format "~a" key))
-       (lambda () (read))))))
-
-(define (hash-stuffer hash store)
-  (make-stuffer
-   (lambda (v)
-     (define hv (hash v))
-     ((store-write store) hv v)
-     hv)
-   (lambda (hv)
-     ((store-read store) hv))))
-
-(require file/md5)
-(define (md5-stuffer home)
-  (hash-stuffer md5 (dir-store home)))
-
-(define (stuffer-compose g f)
-  (make-stuffer
-   (lambda (v)
-     ((stuffer-in g) ((stuffer-in f) v)))
-   (lambda (v)
-     ((stuffer-out f) ((stuffer-out g) v)))))
-
-(define (stuffer-sequence f g)
-  (stuffer-compose g f))
-
-(define (stuffer-if c f)
-  (make-stuffer
-   (lambda (v)
-     (if (c v)
-         (bytes-append #"1" ((stuffer-in f) v))
-         (bytes-append #"0" v)))
-   (lambda (tv)
-     (define tag (subbytes tv 0 1))
-     (define v (subbytes tv 1))
-     (if (bytes=? tag #"1")
-         ((stuffer-out f) v)
-         v))))
-
-(define (stuffer-chain . ss)
-  (match ss
-    [(list)
-     id-stuffer]
-    [(list-rest f ss)
-     (cond
-       [(stuffer? f)     
-        (stuffer-sequence
-         f (apply stuffer-chain ss))]
-       [(procedure? f)
-        (stuffer-if 
-         f (apply stuffer-chain ss))])]))
+         web-server/private/url-param)
 
 (define (is-url-too-big? v)
   (define uri
-    (request-uri (execution-context-request (current-execution-context))))
-  (url-too-big?
-   (do-url-stuff uri v)))
+    (request-uri 
+     (execution-context-request
+      (current-execution-context))))
+  (> (string-length
+      (url->string
+       (insert-in-uri uri v)))
+     ; http://www.boutell.com/newfaq/misc/urllength.html
+     2048))
 
-(define default-stuffer
+(define (make-default-stuffer home)
   (stuffer-chain
    serialize-stuffer
    is-url-too-big?
@@ -112,17 +29,20 @@
     gzip-stuffer 
     base64-stuffer)
    is-url-too-big?
-   (md5-stuffer (md5-home))))
+   (md5-stuffer home)))
+
+(define default-stuffer
+  (make-default-stuffer
+   (build-path (find-system-path 'home-dir) ".urls")))
 
 (define URL-KEY "c")
 
-(define (do-url-stuff uri c)
+(define (insert-in-uri uri c)
   (insert-param uri URL-KEY (bytes->string/utf-8 c)))
 
 (define (stuff-url stuffer uri c)
-  (do-url-stuff
-   uri
-   ((stuffer-in stuffer) c)))
+  (insert-in-uri
+   uri ((stuffer-in stuffer) c)))
 
 (define (stuffed-url? uri)
   (string? (extract-param uri URL-KEY)))
@@ -133,25 +53,9 @@
     (extract-param uri URL-KEY))))
 
 (provide/contract
- [struct stuffer
-         ([in (any/c . -> . bytes?)]
-          [out (bytes? . -> . any/c)])]
- [id-stuffer stuffer?]
- [serialize-stuffer stuffer?]
- [default-stuffer stuffer?])
-
-;; OLD
-
-(provide/contract
- [max-url-length (parameter/c number?)]
- [url-too-big? (url? . -> . boolean?)]
- [stuff-url (stuffer? url? serializable? . -> . url?)]
+ [default-stuffer (stuffer/c serializable? bytes?)]
+ [make-default-stuffer (path-string? . -> . (stuffer/c serializable? bytes?))]
+ [is-url-too-big? (bytes? . -> . boolean?)]
+ [stuff-url ((stuffer/c serializable? bytes?) url? serializable? . -> . url?)]
  [stuffed-url? (url? . -> . boolean?)]
- [unstuff-url (stuffer? url? . -> . serializable?)])
-
-; http://www.boutell.com/newfaq/misc/urllength.html
-(define max-url-length
-  (make-parameter 2048))
-
-(define (url-too-big? uri)
-  ((string-length (url->string uri)) . > . (max-url-length)))
+ [unstuff-url ((stuffer/c serializable? bytes?) url? . -> . serializable?)])
diff --git a/collects/web-server/lang/web.ss b/collects/web-server/lang/web.ss
index 5552da0102..87cfb2933e 100644
--- a/collects/web-server/lang/web.ss
+++ b/collects/web-server/lang/web.ss
@@ -5,10 +5,10 @@
          web-server/http
          web-server/managers/manager
          web-server/private/define-closure
-         web-server/private/servlet         
-         "abort-resume.ss"
-         "stuff-url.ss"
-         "../private/url-param.ss")
+         web-server/private/servlet       
+         web-server/stuffers/stuffer
+         web-server/lang/abort-resume
+         web-server/lang/stuff-url)
 
 (define-struct (stateless-servlet servlet) (stuffer))
 
@@ -24,7 +24,7 @@
 (provide/contract
  [make-stateless-servlet
   (custodian? namespace? manager? path-string? (request? . -> . response/c)
-              stuffer? . -> . stateless-servlet?)])
+              (stuffer/c serializable? bytes?) . -> . stateless-servlet?)])
 
 ; These contracts interfere with the continuation safety marks
 #;(provide/contract
@@ -57,10 +57,11 @@
 (define (send/suspend/hidden page-maker)
   (send/suspend
    (lambda (k)
-     (let ([p-cont (serialize k)])
-       (page-maker
-        (request-uri (execution-context-request (current-execution-context)))
-        `(input ([type "hidden"] [name "kont"] [value ,(format "~s" p-cont)])))))))
+     (define stuffer (stateless-servlet-stuffer (current-servlet)))
+     (define p-cont ((stuffer-in stuffer) k))
+     (page-maker
+      (request-uri (execution-context-request (current-execution-context)))
+      `(input ([type "hidden"] [name "kont"] [value ,(format "~s" p-cont)]))))))
 
 ;; send/suspend/url: (url -> response) -> request
 ;; like send/suspend except the continuation is encoded in the url
@@ -85,16 +86,17 @@
 ;; request->continuation: req -> continuation
 ;; decode the continuation from the hidden field of a request
 (define (request->continuation req)
+  (define stuffer (stateless-servlet-stuffer (current-servlet)))
   (or
    ; Look in url for c=<k>
-   (let* ([req-url (request-uri req)]
-          [stuffer (stateless-servlet-stuffer (current-servlet))])
+   (let ([req-url (request-uri req)])
      (and (stuffed-url? req-url)
           (unstuff-url stuffer req-url)))
    ; Look in query for kont=<k>
    (match (bindings-assq #"kont" (request-bindings/raw req))
      [(struct binding:form (id kont))
-      (deserialize (read (open-input-bytes kont)))]
+      ((stuffer-out stuffer)
+       (read (open-input-bytes kont)))]
      [_ #f])))
 
 (provide/contract
diff --git a/collects/web-server/private/md5-store.ss b/collects/web-server/private/md5-store.ss
deleted file mode 100644
index b7381f062e..0000000000
--- a/collects/web-server/private/md5-store.ss
+++ /dev/null
@@ -1,22 +0,0 @@
-#lang scheme
-(require file/md5)
-
-(provide/contract
- [md5-home (parameter/c path-string?)]
- [md5-store (bytes? . -> . bytes?)]
- [md5-lookup (bytes? . -> . bytes?)])
-
-(define md5-home (make-parameter (build-path (find-system-path 'home-dir) ".urls")))
-
-(define (md5-store bs)
-  (define hash (md5 bs))
-  (with-output-to-file
-      (build-path (md5-home) (format "~a" hash))
-    (lambda ()
-      (write bs))
-    #:exists 'replace)
-  hash)
-(define (md5-lookup hash)
-  (with-input-from-file
-      (build-path (md5-home) (format "~a" hash))
-    (lambda () (read))))
diff --git a/collects/web-server/private/servlet.ss b/collects/web-server/private/servlet.ss
index 0bf2a89792..b50dce5464 100644
--- a/collects/web-server/private/servlet.ss
+++ b/collects/web-server/private/servlet.ss
@@ -4,8 +4,7 @@
          web-server/http)
 
 (define servlet-prompt (make-continuation-prompt-tag 'servlet))
-(define-struct servlet (custodian namespace manager directory handler)
-  #:mutable)
+(define-struct servlet (custodian namespace manager directory [handler #:mutable]))
 (define-struct execution-context (request))
 
 (define current-servlet (make-parameter #f))
diff --git a/collects/web-server/scribblings/dummy-stateless-servlet.ss b/collects/web-server/scribblings/dummy-stateless-servlet.ss
index dff242b2ab..68f97d1288 100644
--- a/collects/web-server/scribblings/dummy-stateless-servlet.ss
+++ b/collects/web-server/scribblings/dummy-stateless-servlet.ss
@@ -1,6 +1,7 @@
 #lang scheme/base
 
 (define interface-version #f)
+(define stuffer #f)
 (define start #f)
 
 (provide (all-defined-out))
diff --git a/collects/web-server/scribblings/lang.scrbl b/collects/web-server/scribblings/lang.scrbl
index 40efa6dbfc..acc06bfd4d 100644
--- a/collects/web-server/scribblings/lang.scrbl
+++ b/collects/web-server/scribblings/lang.scrbl
@@ -36,14 +36,12 @@
 
 @defproc[(send/suspend/hidden [response-generator (url? xexpr/c . -> . response/c)])
          request?]{
- Captures the current continuation. Serializes it and generates an INPUT
- form that includes the serialization as a hidden form.
+ Captures the current continuation. Serializes it and stuffs it into a hidden INPUT
+ form element.
  Calls @scheme[response-generator] with this URL and form field and delivers
  the response to the client. If the URL is invoked with form data containing
  the hidden form,
  the request is returned to this continuation.
-
- Note: The continuation is NOT stuffed.
 }
 
 @defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response/c)])
@@ -59,50 +57,4 @@
 )]{
 
 See @schememodname[web-server/servlet/web].}
-}
-
-@; ------------------------------------------------------------
-@;{
-@section[#:tag "lang/stuff-url.ss"]{Stuff URL}
-@(require (for-label web-server/lang/stuff-url))
-
-@defmodule[web-server/lang/stuff-url]{
-
-@filepath{lang/stuff-url.ss} provides an interface for "stuffing"
-serializable values into URLs. Currently there is a particular
-hard-coded behavior, but we hope to make it more flexible in
-the future.
-
-@defproc[(stuff-url [v serializable?]
-                    [u url?])
-         url?]{
- Returns a URL based on @scheme[u] with @scheme[v] serialized and "stuffed" into it.
- The following steps are applied until the URL is short enough to be accepted by IE.
- @itemize[
-  @item{Put the plain-text serialization in the URL.}
-  @item{Compress the serialization with @schememodname[file/gzip] into the URL.}
-  @item{Compute the MD5 of the compressed seralization and write it to
-   @filepath{$HOME/.urls/M} where `M' is the MD5. `M' is then
-   placed in the URL}
- ]
-}
-
-@defproc[(stuffed-url? [u url?])
-         boolean?]{
- Checks if @scheme[u] appears to be produced by @scheme[stuff-url].
-}
-
-@defproc[(unstuff-url [u url?])
-         serializable?]{
- Extracts the value previously serialized into @scheme[u] by @scheme[stuff-url].
-}
-
-In the future, we will offer the facilities to:
-@itemize[
- @item{Optionally use the content-addressed storage.}
- @item{Use different hashing algorithms for the CAS.}
- @item{Encrypt the serialized value.}
- @item{Only use the CAS if the URL would be too long. (URLs may only be 1024 characters.)}
-]
-}
-;}
\ No newline at end of file
+}
\ No newline at end of file
diff --git a/collects/web-server/scribblings/servlet-env.scrbl b/collects/web-server/scribblings/servlet-env.scrbl
index 533771f502..30cd87f60b 100644
--- a/collects/web-server/scribblings/servlet-env.scrbl
+++ b/collects/web-server/scribblings/servlet-env.scrbl
@@ -11,6 +11,8 @@
                      web-server/configuration/configuration-table
                      web-server/configuration/responders
                      web-server/dispatchers/dispatch-log
+                     scheme/serialize
+                     web-server/stuffers
                      scheme/list))
 
 @defmodule[web-server/servlet-env]{
@@ -97,6 +99,7 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
                                             "^~a$"
                                             (regexp-quote servlet-path)))]
                         [#:stateless? stateless? boolean? #f]
+                        [#:stuffer stuffer (stuffer/c serializable? bytes?) default-stuffer]
                         [#:manager manager manager? (make-threshold-LRU-manager #f (* 1024 1024 64))]
                         [#:servlet-namespace servlet-namespace (listof module-path?) empty]
                         [#:server-root-path server-root-path path-string? default-server-root-path]
@@ -124,7 +127,8 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
  
  If @scheme[quit?] is true, then the URL @filepath["/quit"] ends the server.
   
- If @scheme[stateless?] is true, then the servlet is run as a stateless @schememodname[web-server] module.
+ If @scheme[stateless?] is true, then the servlet is run as a stateless @schememod[web-server] module and @scheme[stuffer] is used
+ as the @tech{stuffer}.
  
  Advanced users may need the following options:
  
@@ -162,6 +166,7 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
           [start (request? . -> . response/c)]
           [#:regexp regexp regexp? #rx""]
           [#:stateless? stateless? boolean? #f]
+          [#:stuffer stuffer (stuffer/c serializable? bytes?) default-stuffer]
           [#:manager manager manager? (make-threshold-LRU-manager #f (* 1024 1024 64))]
           [#:namespace namespace (listof module-path?) empty]
           [#:current-directory servlet-current-directory path-string? (current-directory)])
@@ -173,7 +178,8 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
  The dispatcher responds to requests that match @scheme[regexp]. The current directory
  of servlet execution is @scheme[servlet-current-directory]. 
  
- If @scheme[stateless?] is true, then the servlet is run as a stateless @schememodname[web-server] module.
+ If @scheme[stateless?] is true, then the servlet is run as a stateless @schememod[web-server] module and @scheme[stuffer] is used
+ as the @tech{stuffer}.
 
  The servlet is loaded with @scheme[manager] as its continuation manager. (The default manager limits the amount of memory to 64 MB and
  deals with memory pressure as discussed in the @scheme[make-threshold-LRU-manager] documentation.)
diff --git a/collects/web-server/scribblings/stateless-servlet.scrbl b/collects/web-server/scribblings/stateless-servlet.scrbl
index 7d13446bd0..fdb2248485 100644
--- a/collects/web-server/scribblings/stateless-servlet.scrbl
+++ b/collects/web-server/scribblings/stateless-servlet.scrbl
@@ -4,13 +4,21 @@
 @title[#:tag "stateless-servlets"]{Stateless Servlets}
 
 @(require (for-label web-server/http
-                     "dummy-stateless-servlet.ss")) @; to give a binding context
+                     scheme/serialize
+                     web-server/stuffers
+                     (except-in "dummy-stateless-servlet.ss" stuffer))) @; to give a binding context
 @declare-exporting[#:use-sources (web-server/scribblings/dummy-stateless-servlet)]
 
 @defthing[interface-version (one-of/c 'stateless)]{
  This indicates that the servlet is a stateless servlet.
 }
 
+@defthing[stuffer (stuffer/c serializable? bytes?)]{
+ This is the @scheme[stuffer] that will be used for the servlet.
+      
+ If it is not provided, it defaults to @scheme[default-stuffer].
+}
+
 @defproc[(start [initial-request request?])
          response/c]{
  This function is called when an instance of this servlet is started.
@@ -21,6 +29,10 @@ An example @scheme['stateless] servlet module:
 @schememod[
  web-server
  (define interface-version 'stateless)
+ (define stuffer
+  (stuffer-chain
+   serialize-stuffer
+   (md5-stuffer (build-path (find-system-path 'home-dir) ".urls"))))
  (define (start req)
    `(html (body (h2 "Look ma, no state!"))))
 ]
diff --git a/collects/web-server/scribblings/stuffers.scrbl b/collects/web-server/scribblings/stuffers.scrbl
new file mode 100644
index 0000000000..43afd93645
--- /dev/null
+++ b/collects/web-server/scribblings/stuffers.scrbl
@@ -0,0 +1,196 @@
+#lang scribble/doc
+@(require "web-server.ss")
+
+@(require 
+  (for-label
+   web-server/stuffers/stuffer
+   web-server/stuffers/base64
+   web-server/stuffers/gzip
+   web-server/stuffers/hash
+   web-server/stuffers/serialize
+   web-server/stuffers/store
+   (only-in web-server/lang/stuff-url
+            default-stuffer
+            make-default-stuffer
+            is-url-too-big?)))
+
+@title[#:tag "stuffers.ss"]{Stuffers}
+
+@defmodule[web-server/stuffers]
+
+The @schememod[web-server] module language provides serializable continuations. 
+The serialization functionality is abstracted into @deftech{stuffers} that control how it operates.
+You can supply your own (built with these functions) when you write a stateless servlet.
+
+@section{Basic Combinators}
+
+@defmodule[web-server/stuffers/stuffer]{
+                                        
+@defstruct[stuffer ([in (any/c . -> . any/c)]
+                    [out (any/c . -> . any/c)])]{
+
+ A @tech{stuffer} is essentially an invertible function captured in this structure.
+ The following should hold:
+ @schemeblock[
+  (out (in x)) = x
+  (in (out x)) = x
+ ]                                               
+}
+                                                
+@defproc[(stuffer/c [dom any/c] [rng any/c])
+         contract?]{
+ Constructs a contract for a @tech{stuffer} where @scheme[in] has
+ the contract @scheme[(dom . -> . rng)] and @scheme[out] has the contract
+ @scheme[(rng . -> . dom)].
+}
+                   
+@defthing[id-stuffer (stuffer/c any/c any/c)]{
+ The identitiy @tech{stuffer}.
+}
+
+@defproc[(stuffer-compose [g (stuffer any/c any/c)]
+                          [f (stuffer any/c any/c)])
+         (stuffer any/c any/c)]{
+ Composes @scheme[f] and @scheme[g], i.e., applies @scheme[f] then @scheme[g] for @scheme[in]
+ and @scheme[g] then @scheme[f] for @scheme[out].
+}
+                               
+@defproc[(stuffer-sequence [f (stuffer any/c any/c)]
+                           [g (stuffer any/c any/c)])
+         (stuffer any/c any/c)]{
+ @scheme[stuffer-compose] with arguments swapped.
+}
+                               
+@defproc[(stuffer-if [c (bytes? . -> . boolean?)]
+                     [f (stuffer bytes? bytes?)])
+         (stuffer bytes? bytes?)]{
+ Creates a @tech{stuffer} that stuffs with @scheme[f] if @scheme[c] is true on the input
+ to @scheme[in]. Similarly, applies @scheme[f] during @scheme[out] if it was applied during
+ @scheme[in] (which is recorded by prepending a byte.)
+}
+                                 
+@defproc[(stuffer-chain [x (or/c stuffer? (bytes? . -> . boolean?))]
+                        ...)
+         stuffer?]{
+ Applies @scheme[stuffer-sequence] and @scheme[stuffer-if] to successive tails of @scheme[x].
+}
+                  
+}
+
+@section{Serialization}
+
+@(require (for-label scheme/serialize
+                     web-server/private/util))
+@defmodule[web-server/stuffers/serialize]{
+                                          
+@defthing[serialize-stuffer (stuffer/c serializable? bytes?)]{
+ A @tech{stuffer} that uses @scheme[serialize] and @scheme[write/bytes] and @scheme[deserialize] and @scheme[read/bytes].
+}
+                                          
+}
+
+@section{Base64 Encoding}
+
+@(require (for-label net/base64))
+@defmodule[web-server/stuffers/base64]{
+
+@defthing[base64-stuffer (stuffer/c bytes? bytes?)]{
+ A @tech{stuffer} that uses @scheme[base64-encode] and @scheme[base64-decode].
+   
+ Useful for getting URL-safe bytes.
+}
+         
+}
+
+@section{GZip Compression}
+
+@(require (for-label file/gzip file/gunzip))
+@defmodule[web-server/stuffers/gzip]{
+
+@defthing[gzip-stuffer (stuffer/c bytes? bytes?)]{                                 
+ A @tech{stuffer} that uses @schememodname[file/gzip] and @schememodname[file/gunzip].
+   
+ Note: You should probably compose this with @scheme[base64-stuffer] to get URL-safe bytes.
+}
+         
+}
+
+@section{Key/Value Storage}
+
+The @schememodname[web-server/stuffers/hash] @tech{stuffers} rely on a key/value store.
+
+@defmodule[web-server/stuffers/store]{
+                                      
+ @defstruct[store ([write (bytes? bytes? . -> . void)]
+                   [read (bytes? . -> . bytes?)])]{
+  The following should hold:
+  @schemeblock[
+   (begin (write k v) (read k)) = v
+  ]
+ }
+                                                   
+ @defproc[(dir-store [root path-string?])
+          store?]{
+  A store that stores key @scheme[key]'s value in a file located at @scheme[(build-path root (bytes->string/utf-8 key))].
+ }
+
+ It should be easy to use this interface to create store for databases, like SQLite, CouchDB, or BerkeleyDB.
+}
+
+@section{Hash-addressed Storage}
+
+@(require (for-label file/md5))
+@defmodule[web-server/stuffers/hash]{
+                                     
+ @defthing[hash/c contract?]{
+  Equivalent to @scheme[(bytes? . -> . bytes?)].
+ }
+          
+ @defproc[(hash-stuffer [H hash/c]
+                        [store store?])
+          (stuffer/c bytes? bytes?)]{
+  A content-addressed storage @tech{stuffer} that stores input bytes, @scheme[input], in @scheme[store] with the key @scheme[(H input)]
+  and returns the key. Similarly, on @scheme[out] the original bytes are looked up.
+ }
+                                    
+ @defproc[(md5-stuffer [root path-string?])
+          (stuffer/c bytes? bytes?)]{
+  Equivalent to @scheme[(hash-stuffer md5 (dir-store root))]
+ }
+                                     
+}
+
+@section{Helpers}
+
+@defmodule[web-server/lang/stuff-url]{
+                                      
+@defproc[(is-url-too-big? [v bytes?])
+         boolean?]{
+ Determines if stuffing @scheme[v] into the current servlet's URL would result in a URL that is too big for Internet Explorer.
+ (@link["http://www.boutell.com/newfaq/misc/urllength.html"]{IE only supports URLs up to 2048 characters.}).
+}
+                  
+@defproc[(make-default-stuffer [root path-string?])
+         (stuffer/c serializable? bytes?)]{
+ Constructs a @tech{stuffer} that serializes, then if the URL is too big, compresses (and base64-encodes), if the URL is still too big
+ then it stores it in an MD5-indexed database rooted at @scheme[root].
+                                           
+ Equivalent to:
+ @schemeblock[
+  (stuffer-chain
+   serialize-stuffer
+   is-url-too-big?
+   (stuffer-chain
+    gzip-stuffer 
+    base64-stuffer)
+   is-url-too-big?
+   (md5-stuffer root))
+ ]
+}
+                                          
+@defthing[default-stuffer (stuffer/c serializable? bytes?)]{
+ Equivalent to @scheme[(make-default-stuffer
+                        (build-path (find-system-path 'home-dir) ".urls"))].
+}
+
+}
\ No newline at end of file
diff --git a/collects/web-server/scribblings/writing.scrbl b/collects/web-server/scribblings/writing.scrbl
index 1aea366cc3..435038e1c0 100644
--- a/collects/web-server/scribblings/writing.scrbl
+++ b/collects/web-server/scribblings/writing.scrbl
@@ -33,6 +33,7 @@ This API provides:
 @itemize{
          @item{@schememodname[net/url],}
          @item{@schememodname[web-server/http],}
+         @item{@schememodname[web-server/stuffers],}
          @item{@schememodname[web-server/lang/abort-resume],}
          @item{@schememodname[web-server/lang/web],}
          @item{@schememodname[web-server/lang/web-cells],}
@@ -167,3 +168,4 @@ things in the Web Language, they are sensitive to source code modification.
 @include-section["formlets.scrbl"]
 @include-section["templates.scrbl"]
 @include-section["managers.scrbl"]
+@include-section["stuffers.scrbl"]
diff --git a/collects/web-server/servlet-env.ss b/collects/web-server/servlet-env.ss
index b265558dd7..ed5bf1da97 100644
--- a/collects/web-server/servlet-env.ss
+++ b/collects/web-server/servlet-env.ss
@@ -5,6 +5,7 @@
          scheme/contract
          scheme/list
          scheme/unit
+         scheme/serialize
          net/tcp-unit
          net/tcp-sig
          scheme/runtime-path
@@ -14,6 +15,7 @@
          web-server/managers/manager
          web-server/configuration/namespace
          web-server/http
+         web-server/stuffers
          web-server/configuration/responders
          web-server/private/mime-types
          web-server/servlet/setup
@@ -48,6 +50,7 @@
                      #:current-directory path-string?
                      #:namespace (listof module-path?)
                      #:stateless? boolean?
+                     #:stuffer (stuffer/c serializable? bytes?)
                      #:manager manager?)
                     . ->* .
                     dispatcher/c)]
@@ -71,6 +74,7 @@
                   #:servlet-namespace (listof module-path?)
                   #:server-root-path path-string?
                   #:stateless? boolean?
+                  #:stuffer (stuffer/c serializable? bytes?)
                   #:extra-files-paths (listof path-string?)
                   #:servlets-root path-string?
                   #:servlet-current-directory path-string?
@@ -101,6 +105,8 @@
          [servlet-namespace empty]                  
          #:stateless? 
          [stateless? #f]
+         #:stuffer
+         [stuffer default-stuffer]
          #:manager
          [manager
           (make-threshold-LRU-manager
@@ -123,7 +129,7 @@
                                   #:additional-specs
                                   default-module-specs)])
                    (if stateless?
-                       (make-stateless.servlet servlet-current-directory start)
+                       (make-stateless.servlet servlet-current-directory stuffer start)
                        (make-v2.servlet servlet-current-directory manager start)))])
             (set-box! servlet-box servlet)
             servlet))))))
@@ -210,6 +216,8 @@
          [servlet-regexp (regexp (format "^~a$" (regexp-quote servlet-path)))]
          #:stateless?
          [stateless? #f]
+         #:stuffer
+         [stuffer default-stuffer]
 
          #:servlet-namespace
          [servlet-namespace empty]
@@ -245,6 +253,7 @@
       #:regexp servlet-regexp
       #:namespace servlet-namespace
       #:stateless? stateless?
+      #:stuffer stuffer
       #:current-directory servlet-current-directory
       #:manager manager)
      (let-values ([(clear-cache! url->servlet)
diff --git a/collects/web-server/servlet/setup.ss b/collects/web-server/servlet/setup.ss
index b1b7a7f85d..85a99a78c6 100644
--- a/collects/web-server/servlet/setup.ss
+++ b/collects/web-server/servlet/setup.ss
@@ -1,10 +1,10 @@
-#lang scheme/base
-(require mzlib/plt-match
-         scheme/contract)
-(require web-server/managers/manager
+#lang scheme
+(require scheme/serialize
+         web-server/managers/manager
          web-server/managers/timeouts
          web-server/managers/none
          web-server/lang/stuff-url
+         web-server/stuffers/stuffer
          (only-in web-server/lang/web
                   initialize-servlet
                   make-stateless-servlet)
@@ -67,14 +67,14 @@
        (parameterize ([current-servlet-instance-id instance-id])
          (handler req))))))
 
-(define (make-stateless.servlet directory start)
+(define (make-stateless.servlet directory stuffer start)
   (define ses 
     (make-stateless-servlet
      (current-custodian) (current-namespace)
      (create-none-manager (lambda (req) (error "No continuations!")))
      directory
      (lambda (req) (error "Session not initialized"))
-     default-stuffer))
+     stuffer))
   (parameterize ([current-directory directory]
                  [current-servlet ses])    
     (set-servlet-handler! ses (initialize-servlet start)))
@@ -110,7 +110,7 @@
 (provide/contract
  [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? (request? . -> . response/c) . -> . servlet?)]
+ [make-stateless.servlet (path-string? (stuffer/c serializable? bytes?) (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)]
@@ -162,8 +162,12 @@
                 (let ([start (contract (request? . -> . response/c)
                                        (dynamic-require module-name 'start)
                                        pos-blame neg-blame
-                                       (mk-loc "start"))])
-                  (make-stateless.servlet (directory-part a-path) start))]))]
+                                       (mk-loc "start"))]
+                      [stuffer (contract (stuffer/c serializable? bytes?)
+                                         (dynamic-require module-name 'stuffer (lambda () default-stuffer))
+                                         pos-blame neg-blame
+                                         (mk-loc "stuffer"))])
+                  (make-stateless.servlet (directory-part a-path) stuffer start))]))]
           [else
            (make-v1.servlet (directory-part a-path) timeouts-default-servlet
                             (v0.response->v1.lambda 
diff --git a/collects/web-server/stuffers.ss b/collects/web-server/stuffers.ss
new file mode 100644
index 0000000000..96131e44e8
--- /dev/null
+++ b/collects/web-server/stuffers.ss
@@ -0,0 +1,19 @@
+#lang scheme
+(require web-server/stuffers/stuffer
+         web-server/stuffers/base64
+         web-server/stuffers/gzip
+         web-server/stuffers/hash
+         web-server/stuffers/serialize
+         web-server/stuffers/store
+         (only-in web-server/lang/stuff-url
+                  default-stuffer
+                  make-default-stuffer
+                  is-url-too-big?))
+(provide
+ (all-from-out web-server/stuffers/stuffer
+               web-server/stuffers/base64
+               web-server/stuffers/gzip
+               web-server/stuffers/hash
+               web-server/stuffers/serialize
+               web-server/stuffers/store
+               web-server/lang/stuff-url))
\ No newline at end of file
diff --git a/collects/web-server/stuffers/base64.ss b/collects/web-server/stuffers/base64.ss
new file mode 100644
index 0000000000..a1d3552231
--- /dev/null
+++ b/collects/web-server/stuffers/base64.ss
@@ -0,0 +1,9 @@
+#lang scheme
+(require web-server/stuffers/stuffer
+         net/base64)
+
+(define base64-stuffer
+  (make-stuffer base64-encode base64-decode))
+
+(provide/contract
+ [base64-stuffer (stuffer/c bytes? bytes?)])
\ No newline at end of file
diff --git a/collects/web-server/stuffers/gzip.ss b/collects/web-server/stuffers/gzip.ss
new file mode 100644
index 0000000000..9ee24bce6d
--- /dev/null
+++ b/collects/web-server/stuffers/gzip.ss
@@ -0,0 +1,9 @@
+#lang scheme
+(require web-server/private/gzip
+         web-server/stuffers/stuffer)
+
+(define gzip-stuffer
+  (make-stuffer gzip/bytes gunzip/bytes))
+
+(provide/contract
+ [gzip-stuffer (stuffer/c bytes? bytes?)])
\ No newline at end of file
diff --git a/collects/web-server/stuffers/hash.ss b/collects/web-server/stuffers/hash.ss
new file mode 100644
index 0000000000..98ce3529bf
--- /dev/null
+++ b/collects/web-server/stuffers/hash.ss
@@ -0,0 +1,24 @@
+#lang scheme
+(require web-server/stuffers/stuffer
+         web-server/stuffers/store
+         file/md5)
+
+(define hash/c
+  (bytes? . -> . bytes?))
+
+(define (hash-stuffer hash store)
+  (make-stuffer
+   (lambda (v)
+     (define hv (hash v))
+     ((store-write store) hv v)
+     hv)
+   (lambda (hv)
+     ((store-read store) hv))))
+
+(define (md5-stuffer home)
+  (hash-stuffer md5 (dir-store home)))
+
+(provide/contract
+ [hash/c contract?]
+ [hash-stuffer (hash/c store? . -> . (stuffer/c bytes? bytes?))]
+ [md5-stuffer (path-string? . -> . (stuffer/c bytes? bytes?))])
\ No newline at end of file
diff --git a/collects/web-server/stuffers/serialize.ss b/collects/web-server/stuffers/serialize.ss
new file mode 100644
index 0000000000..1598f375d0
--- /dev/null
+++ b/collects/web-server/stuffers/serialize.ss
@@ -0,0 +1,13 @@
+#lang scheme
+(require scheme/serialize
+         web-server/stuffers/stuffer
+         "../private/util.ss"
+         "../private/mod-map.ss")
+
+(define serialize-stuffer
+  (make-stuffer
+   (lambda (v) (write/bytes (compress-serial (serialize v))))
+   (lambda (v) (deserialize (decompress-serial (read/bytes v))))))
+
+(provide/contract
+ [serialize-stuffer (stuffer/c serializable? bytes?)])
\ No newline at end of file
diff --git a/collects/web-server/stuffers/store.ss b/collects/web-server/stuffers/store.ss
new file mode 100644
index 0000000000..4f66f44f7a
--- /dev/null
+++ b/collects/web-server/stuffers/store.ss
@@ -0,0 +1,20 @@
+#lang scheme
+(define-struct store (write read))
+
+(define (dir-store home)
+  (make-store
+   (lambda (key value)
+     (with-output-to-file
+         (build-path home (bytes->string/utf-8 key))
+       (lambda ()
+         (write value))
+       #:exists 'replace))
+   (lambda (key)
+     (with-input-from-file
+         (build-path home (bytes->string/utf-8 key))
+       (lambda () (read))))))
+
+(provide/contract
+ [struct store ([write (bytes? bytes? . -> . void)]
+                [read (bytes? . -> . bytes?)])]
+ [dir-store (path-string? . -> . store?)])
\ No newline at end of file
diff --git a/collects/web-server/stuffers/stuffer.ss b/collects/web-server/stuffers/stuffer.ss
new file mode 100644
index 0000000000..321c61e424
--- /dev/null
+++ b/collects/web-server/stuffers/stuffer.ss
@@ -0,0 +1,80 @@
+#lang scheme
+
+(define-struct stuffer (in out))
+(define (stuffer/c dom rng)
+  (define in (dom . -> . rng))
+  (define in-proc (contract-proc in))
+  (define out (rng . -> . dom))  
+  (define out-proc (contract-proc out))
+  (make-proj-contract
+   (build-compound-type-name 'stuffer/c in out)
+   (λ (pos-blame neg-blame src-info orig-str)
+     (define in-app (in-proc pos-blame neg-blame src-info orig-str))
+     (define out-app (out-proc pos-blame neg-blame src-info orig-str))
+     (λ (val)
+       (unless (stuffer? val)
+         (raise-contract-error
+          val
+          src-info
+          pos-blame
+          'ignored
+          orig-str
+          "expected <stuffer>, given: ~e"
+          val))
+       (make-stuffer
+        (in-app (stuffer-in val))
+        (out-app (stuffer-out val)))))
+   stuffer?))
+
+(define id-stuffer
+  (make-stuffer 
+   (lambda (v) v)
+   (lambda (v) v)))
+
+(define (stuffer-compose g f)
+  (make-stuffer
+   (lambda (v)
+     ((stuffer-in g) ((stuffer-in f) v)))
+   (lambda (v)
+     ((stuffer-out f) ((stuffer-out g) v)))))
+
+(define (stuffer-sequence f g)
+  (stuffer-compose g f))
+
+(define (stuffer-if c f)
+  (make-stuffer
+   (lambda (v)
+     (if (c v)
+         (bytes-append #"1" ((stuffer-in f) v))
+         (bytes-append #"0" v)))
+   (lambda (tv)
+     (define tag (subbytes tv 0 1))
+     (define v (subbytes tv 1))
+     (if (bytes=? tag #"1")
+         ((stuffer-out f) v)
+         v))))
+
+(define (stuffer-chain . ss)
+  (match ss
+    [(list)
+     id-stuffer]
+    [(list-rest f ss)
+     (cond
+       [(stuffer? f)     
+        (stuffer-sequence
+         f (apply stuffer-chain ss))]
+       [(procedure? f)
+        (stuffer-if 
+         f (apply stuffer-chain ss))])]))
+
+(define-values (alpha beta gamma) (values any/c any/c any/c))
+(provide/contract
+ [struct stuffer
+         ([in (any/c . -> . any/c)]
+          [out (any/c . -> . any/c)])]
+ [stuffer/c (any/c any/c . -> . contract?)]
+ [id-stuffer (stuffer/c alpha alpha)]
+ [stuffer-compose ((stuffer/c beta gamma) (stuffer/c alpha beta) . -> . (stuffer/c alpha gamma))]
+ [stuffer-sequence ((stuffer/c alpha beta) (stuffer/c beta gamma) . -> . (stuffer/c alpha gamma))]
+ [stuffer-if ((bytes? . -> . boolean?) (stuffer/c bytes? bytes?) . -> . (stuffer/c bytes? bytes?))]
+ [stuffer-chain (() () #:rest (listof (or/c stuffer? (bytes? . -> . boolean?))) . ->* . stuffer?)])
\ No newline at end of file