diff --git a/Network/Wai/Handler/CGI.hs b/Network/Wai/Handler/CGI.hs
--- a/Network/Wai/Handler/CGI.hs
+++ b/Network/Wai/Handler/CGI.hs
@@ -1,21 +1,34 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 module Network.Wai.Handler.CGI
     ( run
     , run'
     , run''
     , runSendfile
+    , requestBodyFunc
     ) where
 
 import Network.Wai
-import Network.Wai.Enumerator (fromResponseBody)
-import Network.Wai.Handler.Helper
+import Network.Socket (getAddrInfo, addrAddress)
 import System.Environment (getEnvironment)
 import Data.Maybe (fromMaybe)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as L
 import Control.Arrow ((***))
 import Data.Char (toLower)
 import qualified System.IO
-import Data.String (fromString)
+import qualified Data.String as String
+import Data.Enumerator
+    ( Enumerator, Step (..), Stream (..), continue, yield
+    , enumList, ($$), joinI, returnI, (>>==), run_
+    )
+import Data.Monoid (mconcat)
+import Blaze.ByteString.Builder (fromByteString, toLazyByteString)
+import Blaze.ByteString.Builder.Char8 (fromChar, fromString)
+import Blaze.ByteString.Builder.Enumerator (builderToByteString)
+import Control.Monad.IO.Class (liftIO)
+import Data.ByteString.Lazy.Internal (defaultChunkSize)
+import System.IO (Handle)
 
 safeRead :: Read a => a -> String -> a
 safeRead d s =
@@ -33,7 +46,7 @@
         output = B.hPut System.IO.stdout
     run'' vars input output Nothing app
 
-runSendfile :: String -- ^ sendfile header
+runSendfile :: B.ByteString -- ^ sendfile header
             -> Application -> IO ()
 runSendfile sf app = do
     vars <- getEnvironment
@@ -52,9 +65,9 @@
     run'' vars input output Nothing app
 
 run'' :: [(String, String)] -- ^ all variables
-     -> (Int -> Source) -- ^ responseBody of input
+     -> (forall a. Int -> Enumerator B.ByteString IO a) -- ^ responseBody of input
      -> (B.ByteString -> IO ()) -- ^ destination for output
-     -> Maybe String -- ^ does the server support the X-Sendfile header?
+     -> Maybe B.ByteString -- ^ does the server support the X-Sendfile header?
      -> Application
      -> IO ()
 run'' vars inputH outputH xsendfile app = do
@@ -65,16 +78,21 @@
         serverport = safeRead 80 $ lookup' "SERVER_PORT" vars
         contentLength = safeRead 0 $ lookup' "CONTENT_LENGTH" vars
         remoteHost' =
-            case lookup "REMOTE_HOST" vars of
+            case lookup "REMOTE_ADDR" vars of
                 Just x -> x
                 Nothing ->
-                    case lookup "REMOTE_ADDR" vars of
+                    case lookup "REMOTE_HOST" vars of
                         Just x -> x
                         Nothing -> ""
         isSecure' =
             case map toLower $ lookup' "SERVER_PROTOCOL" vars of
                 "https" -> True
                 _ -> False
+    addrs <- getAddrInfo Nothing (Just remoteHost') Nothing
+    let addr =
+            case addrs of
+                a:_ -> addrAddress a
+                [] -> error $ "Invalid REMOTE_ADDR or REMOTE_HOST: " ++ remoteHost'
     let env = Request
             { requestMethod = rmethod
             , pathInfo = B.pack pinfo
@@ -83,53 +101,51 @@
             , serverPort = serverport
             , requestHeaders = map (cleanupVarName *** B.pack) vars
             , isSecure = isSecure'
-            , requestBody = inputH contentLength
             , errorHandler = System.IO.hPutStr System.IO.stderr
-            , remoteHost = B.pack remoteHost'
+            , remoteHost = addr
             , httpVersion = "1.1" -- FIXME
             }
-    res <- app env
-    let h = responseHeaders res
-    let h' = case lookup "Content-Type" h of
-                Nothing -> ("Content-Type", "text/html; charset=utf-8")
-                         : h
-                Just _ -> h
-    let hPut = outputH
-    hPut $ B.pack $ "Status: " ++ (show $ statusCode $ status res) ++ " "
-    hPut $ statusMessage $ status res
-    hPut $ B.singleton '\n'
-    mapM_ (printHeader hPut) h'
-    case (xsendfile, responseBody res) of
-        (Just sf, ResponseFile fp) ->
-            hPut $ B.pack $ concat
-                [ sf
-                , ": "
-                , fp
-                , "\n\n"
-                , sf
-                , " not supported"
-                ]
-        _ -> do
-            hPut $ B.singleton '\n'
-            _ <- runEnumerator (fromResponseBody (responseBody res))
-                               (myPut outputH) ()
-            return ()
-
-myPut :: (B.ByteString -> IO ()) -> () -> B.ByteString -> IO (Either () ())
-myPut output _ bs = output bs >> return (Right ())
-
-printHeader :: (B.ByteString -> IO ())
-            -> (ResponseHeader, B.ByteString)
-            -> IO ()
-printHeader f (x, y) = do
-    f $ ciOriginal x
-    f $ B.pack ": "
-    f y
-    f $ B.singleton '\n'
+    -- FIXME worry about exception?
+    res <- run_ $ inputH contentLength $$ app env
+    case (xsendfile, res) of
+        (Just sf, ResponseFile s hs fp) ->
+            mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp
+        _ -> responseEnumerator res $ \s hs ->
+            joinI $ enumList 1 [headers s hs, fromChar '\n'] $$ builderIter
+  where
+    headers s hs = mconcat (map header $ status s : map header' (fixHeaders hs))
+    status (Status i m) = (fromByteString "Status", mconcat
+        [ fromString $ show i
+        , fromChar ' '
+        , fromByteString m
+        ])
+    header' (x, y) = (fromByteString $ ciOriginal x, fromByteString y)
+    header (x, y) = mconcat
+        [ x
+        , fromByteString ": "
+        , y
+        , fromChar '\n'
+        ]
+    sfBuilder s hs sf fp = mconcat
+        [ headers s hs
+        , header $ (fromByteString sf, fromString fp)
+        , fromChar '\n'
+        , fromByteString sf
+        , fromByteString " not supported"
+        ]
+    bsStep = Continue bsStep'
+    bsStep' EOF = yield () EOF
+    bsStep' (Chunks []) = continue bsStep'
+    bsStep' (Chunks bss) = liftIO (mapM_ outputH bss) >> continue bsStep'
+    builderIter = builderToByteString bsStep
+    fixHeaders h =
+        case lookup "content-type" h of
+            Nothing -> ("Content-Type", "text/html; charset=utf-8") : h
+            Just _ -> h
 
 cleanupVarName :: String -> RequestHeader
 cleanupVarName ('H':'T':'T':'P':'_':a:as) =
-    fromString $ a : helper' as
+    String.fromString $ a : helper' as
   where
     helper' ('_':x:rest) = '-' : x : helper' rest
     helper' (x:rest) = toLower x : helper' rest
@@ -137,4 +153,23 @@
 cleanupVarName "CONTENT_TYPE" = "Content-Type"
 cleanupVarName "CONTENT_LENGTH" = "Content-Length"
 cleanupVarName "SCRIPT_NAME" = "CGI-Script-Name"
-cleanupVarName x = fromString x -- FIXME remove?
+cleanupVarName x = String.fromString x -- FIXME remove?
+
+requestBodyHandle :: Handle -> Int -> Enumerator B.ByteString IO a
+requestBodyHandle h =
+    requestBodyFunc go
+  where
+    go i = Just `fmap` B.hGet h (min i defaultChunkSize)
+
+requestBodyFunc :: (Int -> IO (Maybe B.ByteString))
+                -> Int
+                -> Enumerator B.ByteString IO a
+requestBodyFunc _ 0 step = returnI step
+requestBodyFunc h len (Continue k) = do
+    mbs <- liftIO $ h len
+    case mbs of
+        Nothing -> continue k
+        Just bs -> do
+            let newLen = len - B.length bs
+            k (Chunks [bs]) >>== requestBodyFunc h newLen
+requestBodyFunc _ _ step = returnI step
diff --git a/Network/Wai/Handler/Helper.hs b/Network/Wai/Handler/Helper.hs
deleted file mode 100644
--- a/Network/Wai/Handler/Helper.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-module Network.Wai.Handler.Helper
-    ( requestBodyHandle
-    , requestBodyFunc
-    ) where
-
-import System.IO (Handle)
-import qualified Data.ByteString as B
-import Data.ByteString.Lazy.Internal (defaultChunkSize)
-import Network.Wai (Source (..))
-
-requestBodyHandle :: Handle -> Int -> Source
-requestBodyHandle h =
-    requestBodyFunc go
-  where
-    go i = Just `fmap` B.hGet h (min i defaultChunkSize)
-
-requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> Source
-requestBodyFunc _ 0 = Source $ return Nothing
-requestBodyFunc h len = Source $ do
-    mbs <- h len
-    case mbs of
-        Nothing -> return Nothing
-        Just bs -> do
-            let newLen = len - B.length bs
-            return $ Just (bs, requestBodyFunc h $ max 0 newLen)
diff --git a/Network/Wai/Handler/SimpleServer.hs b/Network/Wai/Handler/SimpleServer.hs
deleted file mode 100644
--- a/Network/Wai/Handler/SimpleServer.hs
+++ /dev/null
@@ -1,190 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
----------------------------------------------------------
--- |
--- Module        : Network.Wai.Handler.SimpleServer
--- Copyright     : Michael Snoyman
--- License       : BSD3
---
--- Maintainer    : Michael Snoyman <michael@snoyman.com>
--- Stability     : Stable
--- Portability   : portable
---
--- A simplistic HTTP server handler for Wai.
---
----------------------------------------------------------
-module Network.Wai.Handler.SimpleServer
-    ( run
-    , sendResponse
-    , parseRequest
-    ) where
-
-import Network.Wai
-import Network.Wai.Handler.Helper
-import qualified System.IO
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy as L
-import Network
-    ( listenOn, accept, sClose, PortID(PortNumber), Socket
-    , withSocketsDo)
-import Control.Exception (bracket, finally, Exception, throwIO)
-import System.IO (Handle, hClose)
-import Control.Concurrent (forkIO)
-import Control.Monad (unless)
-import Data.Maybe (isJust, fromJust, fromMaybe)
-
-import Data.Typeable (Typeable)
-
-import Control.Arrow (first)
-import Numeric (showHex)
-
-run :: Port -> Application -> IO ()
-run port = withSocketsDo .
-    bracket
-        (listenOn $ PortNumber $ fromIntegral port)
-        sClose .
-        serveConnections port
-type Port = Int
-
-serveConnections :: Port -> Application -> Socket -> IO ()
-serveConnections port app socket = do
-    (conn, remoteHost', _) <- accept socket
-    _ <- forkIO $ serveConnection port app conn remoteHost'
-    serveConnections port app socket
-
-serveConnection :: Port -> Application -> Handle -> String -> IO ()
-serveConnection port app conn remoteHost' =
-    finally
-        serveConnection'
-        (hClose conn)
-    where
-        serveConnection' = do
-            env <- parseRequest port conn remoteHost'
-            res <- app env
-            sendResponse (httpVersion env) conn res
-
-parseRequest :: Port -> Handle -> String -> IO Request
-parseRequest port conn remoteHost' = do
-    headers' <- takeUntilBlank conn id
-    parseRequest' port headers' conn remoteHost'
-
-takeUntilBlank :: Handle
-               -> ([ByteString] -> [ByteString])
-               -> IO [ByteString]
-takeUntilBlank h front = do
-    l <- stripCR `fmap` B.hGetLine h
-    if B.null l
-        then return $ front []
-        else takeUntilBlank h $ front . (:) l
-
-stripCR :: ByteString -> ByteString
-stripCR bs
-    | B.null bs = bs
-    | B.last bs == '\r' = B.init bs
-    | otherwise = bs
-
-data InvalidRequest =
-    NotEnoughLines [String]
-    | HostNotIncluded
-    | BadFirstLine String
-    | NonHttp
-    deriving (Show, Typeable)
-instance Exception InvalidRequest
-
--- | Parse a set of header lines and body into a 'Request'.
-parseRequest' :: Port
-              -> [ByteString]
-              -> Handle
-              -> String
-              -> IO Request
-parseRequest' port lines' handle remoteHost' = do
-    case lines' of
-        (_:_:_) -> return ()
-        _ -> throwIO $ NotEnoughLines $ map B.unpack lines'
-    (method, rpath', gets, httpversion) <- parseFirst $ head lines'
-    let rpath = '/' : case B.unpack rpath' of
-                        ('/':x) -> x
-                        _ -> B.unpack rpath'
-    let heads = map (first mkCIByteString . parseHeaderNoAttr) $ tail lines'
-    let host' = lookup "Host" heads
-    unless (isJust host') $ throwIO HostNotIncluded
-    let host = fromJust host'
-    let len = fromMaybe 0 $ do
-                bs <- lookup "Content-Length" heads
-                let str = B.unpack bs
-                case reads str of
-                    (x, _):_ -> Just x
-                    _ -> Nothing
-    let (serverName', _) = B.break (== ':') host
-    return $ Request
-                { requestMethod = method
-                , httpVersion = httpversion
-                , pathInfo = B.pack rpath
-                , queryString = gets
-                , serverName = serverName'
-                , serverPort = port
-                , requestHeaders = heads
-                , isSecure = False
-                , requestBody = requestBodyHandle handle len
-                , errorHandler = System.IO.hPutStr System.IO.stderr
-                , remoteHost = B.pack remoteHost'
-                }
-
-parseFirst :: ByteString
-           -> IO (ByteString, ByteString, ByteString, HttpVersion)
-parseFirst s = do
-    let pieces = B.words s
-    (method, query, http') <-
-        case pieces of
-            [x, y, z] -> return (x, y, z)
-            _ -> throwIO $ BadFirstLine $ B.unpack s
-    let (hfirst, hsecond) = B.splitAt 5 http'
-    unless (hfirst == B.pack "HTTP/") $ throwIO NonHttp
-    let (rpath, qstring) = B.break (== '?') query
-    return (method, rpath, qstring, hsecond)
-
-sendResponse :: HttpVersion -> Handle -> Response -> IO ()
-sendResponse httpversion h res = do
-    B.hPut h $ B.pack "HTTP/"
-    B.hPut h $ httpversion
-    B.hPut h $ B.pack " "
-    B.hPut h $ B.pack $ show $ statusCode $ status res
-    B.hPut h $ B.pack " "
-    B.hPut h $ statusMessage $ status res
-    B.hPut h $ B.pack "\r\n"
-    mapM_ putHeader $ responseHeaders res
-    B.hPut h $ B.pack "Transfer-Encoding: chunked\r\n\r\n"
-    case responseBody res of
-        ResponseFile fp -> do
-            -- FIXME this is lazy I/O
-            lbs <- L.readFile fp
-            mapM_ myPut $ L.toChunks lbs
-        ResponseEnumerator (Enumerator enum) ->
-            enum (const myPut) h >> return ()
-        ResponseLBS lbs -> mapM_ myPut $ L.toChunks lbs
-    B.hPut h $ B.pack "0\r\n\r\n"
-    where
-        myPut bs = do
-            B.hPut h $ B.pack $ showHex (B.length bs) " \r\n"
-            B.hPut h bs
-            B.hPut h $ B.pack "\r\n"
-            return (Right h)
-        putHeader (x, y) = do
-            B.hPut h $ ciOriginal x
-            B.hPut h $ B.pack ": "
-            B.hPut h y
-            B.hPut h $ B.pack "\r\n"
-
-parseHeaderNoAttr :: ByteString -> (ByteString, ByteString)
-parseHeaderNoAttr s =
-    let (k, rest) = B.span (/= ':') s
-        rest' = if not (B.null rest) &&
-                   B.head rest == ':' &&
-                   not (B.null $ B.tail rest) &&
-                   B.head (B.tail rest) == ' '
-                    then B.drop 2 rest
-                    else rest
-     in (k, rest')
diff --git a/Network/Wai/Middleware/Autohead.hs b/Network/Wai/Middleware/Autohead.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Middleware/Autohead.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- | Automatically produce responses to HEAD requests based on the underlying
+-- applications GET response.
+module Network.Wai.Middleware.Autohead (autohead) where
+
+import Network.Wai
+import Data.Monoid (mempty)
+import Data.Enumerator (enumEOF, ($$))
+
+autohead :: Middleware
+autohead app req
+    | requestMethod req == "HEAD" = do
+        res <- app req { requestMethod = "GET" }
+        case res of
+            ResponseFile s hs _ -> return $ ResponseBuilder s hs mempty
+            ResponseBuilder s hs _ -> return $ ResponseBuilder s hs mempty
+            ResponseEnumerator e -> do
+                let helper f =
+                        let helper' s hs = enumEOF $$ f s hs
+                         in e helper'
+                return $ ResponseEnumerator helper
+    | otherwise = app req
+
diff --git a/Network/Wai/Middleware/CleanPath.hs b/Network/Wai/Middleware/CleanPath.hs
--- a/Network/Wai/Middleware/CleanPath.hs
+++ b/Network/Wai/Middleware/CleanPath.hs
@@ -1,29 +1,23 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Network.Wai.Middleware.CleanPath
     ( cleanPath
-    , cleanPathRel
-    , cleanPathFunc
-    , splitPath
     ) where
 
 import Network.Wai
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as L
-import Network.URI (unEscapeString)
-import qualified Data.ByteString.UTF8 as BSU
 
-cleanPathFunc :: (B.ByteString -> Either B.ByteString [String])
-              -> B.ByteString
-              -> ([String] -> Request -> IO Response)
-              -> Request
-              -> IO Response
-cleanPathFunc splitter prefix app env =
+cleanPath :: (B.ByteString -> Either B.ByteString [String])
+          -> B.ByteString
+          -> ([String] -> Application)
+          -> Application
+cleanPath splitter prefix app env =
     case splitter $ pathInfo env of
         Right pieces -> app pieces env
         Left p -> return
-                . Response status301
+                $ responseLBS status301
                   [("Location", B.concat [prefix, p, suffix])]
-                $ ResponseLBS L.empty
+                $ L.empty
     where
         -- include the query string if present
         suffix =
@@ -31,60 +25,3 @@
                 Nothing -> B.empty
                 Just ('?', _) -> queryString env
                 _ -> B.cons '?' $ queryString env
-
--- | Performs redirects as per 'splitPath'.
-cleanPathRel :: B.ByteString -> ([String] -> Request -> IO Response)
-             -> Request -> IO Response
-cleanPathRel = cleanPathFunc splitPath
-
-cleanPath :: ([String] -> Request -> IO Response) -> Request -> IO Response
-cleanPath = cleanPathRel B.empty
-
--- | Given a certain requested path, return either a corrected path
--- to redirect to or the tokenized path.
---
--- This code corrects for the following issues:
---
--- * It is missing a trailing slash, and there is no period after the
--- last slash.
---
--- * There are any doubled slashes.
-splitPath :: B.ByteString -> Either B.ByteString [String]
-splitPath s =
-    let corrected = B.pack $ rts $ ats $ rds $ B.unpack s
-     in if corrected == s
-            then Right $ map (BSU.toString . B.pack . unEscapeString . B.unpack)
-                       $ filter (not . B.null)
-                       $ B.split '/' s
-            else Left corrected
-
--- | Remove double slashes
-rds :: String -> String
-rds [] = []
-rds [x] = [x]
-rds (a:b:c)
-    | a == '/' && b == '/' = rds (b:c)
-    | otherwise = a : rds (b:c)
-
--- | Add a trailing slash if it is missing. Empty string is left alone.
-ats :: String -> String
-ats [] = []
-ats s =
-    if last s == '/' || dbs (reverse s)
-        then s
-        else s ++ "/"
-
--- | Remove a trailing slash if the last piece has a period.
-rts :: String -> String
-rts [] = []
-rts s =
-    if last s == '/' && dbs (tail $ reverse s)
-        then init s
-        else s
-
--- | Is there a period before a slash here?
-dbs :: String -> Bool
-dbs ('/':_) = False
-dbs ('.':_) = True
-dbs (_:x) = dbs x
-dbs [] = False
diff --git a/Network/Wai/Middleware/Debug.hs b/Network/Wai/Middleware/Debug.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Middleware/Debug.hs
@@ -0,0 +1,16 @@
+module Network.Wai.Middleware.Debug (debug) where
+
+import Network.Wai (Middleware, requestMethod, pathInfo)
+import Data.ByteString.Char8 (unpack)
+import System.IO (hPutStrLn, stderr)
+import Control.Monad.IO.Class (liftIO)
+
+-- | Prints a message to 'stderr' for each request.
+debug :: Middleware
+debug app req = do
+    liftIO $ hPutStrLn stderr $ concat
+        [ unpack $ requestMethod req
+        , " "
+        , unpack $ pathInfo req
+        ]
+    app req
diff --git a/Network/Wai/Middleware/Gzip.hs b/Network/Wai/Middleware/Gzip.hs
--- a/Network/Wai/Middleware/Gzip.hs
+++ b/Network/Wai/Middleware/Gzip.hs
@@ -17,10 +17,10 @@
 module Network.Wai.Middleware.Gzip (gzip) where
 
 import Network.Wai
-import Network.Wai.Enumerator (fromResponseBody)
 import Network.Wai.Zlib
 import Data.Maybe (fromMaybe)
 import qualified Data.ByteString.Char8 as B
+import Data.Enumerator (($$), joinI)
 
 -- | Use gzip to compress the body of the response.
 --
@@ -31,30 +31,31 @@
 --
 -- * Only compress if the response is above a certain size.
 --
--- * Add Content-Length.
---
--- * I read somewhere that \"the beast\" (MSIE) can\'t support compression
--- for Javascript files..
-gzip :: Middleware
-gzip app env = do
+-- * I've read that IE can\'t support compression for Javascript files.
+gzip :: Bool -- ^ should we gzip files?
+     -> Middleware
+gzip files app env = do
     res <- app env
-    case responseBody res of
-        ResponseFile _ -> return res
-        _ -> do
-            let enc = fromMaybe []
-                    $ (splitCommas . B.unpack)
-                    `fmap` lookup "Accept-Encoding"
-                      (requestHeaders env)
-            if "gzip" `elem` enc
-                then return res
-                    { responseBody = compressE $ responseBody res
-                    , responseHeaders = ("Content-Encoding", "gzip")
-                              : responseHeaders res
-                    }
-                else return res
+    return $
+        case res of
+            ResponseFile{} | not files -> res
+            _ -> if "gzip" `elem` enc
+                    then ResponseEnumerator $ compressE $ responseEnumerator res
+                    else res
+  where
+    enc = fromMaybe [] $ (splitCommas . B.unpack)
+                    `fmap` lookup "Accept-Encoding" (requestHeaders env)
 
-compressE :: ResponseBody -> ResponseBody
-compressE = ResponseEnumerator . compress . fromResponseBody
+compressE :: (forall a. ResponseEnumerator a)
+          -> (forall a. ResponseEnumerator a)
+compressE re f =
+    re f'
+    --e s hs'
+  where
+    f' s hs =
+        joinI $ compress $$ f s hs'
+      where
+        hs' = ("Content-Encoding", "gzip") : hs
 
 splitCommas :: String -> [String]
 splitCommas [] = []
diff --git a/Network/Wai/Middleware/Jsonp.hs b/Network/Wai/Middleware/Jsonp.hs
--- a/Network/Wai/Middleware/Jsonp.hs
+++ b/Network/Wai/Middleware/Jsonp.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 ---------------------------------------------------------
 -- |
 -- Module        : Network.Wai.Middleware.Jsonp
@@ -15,9 +16,12 @@
 module Network.Wai.Middleware.Jsonp (jsonp) where
 
 import Network.Wai
-import Network.Wai.Enumerator (fromResponseBody)
 import qualified Data.ByteString.Char8 as B8
 import Data.Maybe (fromMaybe)
+import Data.Enumerator (($$), enumList, Step (..), Enumerator, Iteratee, Enumeratee, joinI, checkDone, continue, Stream (..), (>>==))
+import Blaze.ByteString.Builder (copyByteString, Builder)
+import Blaze.ByteString.Builder.Char8 (fromChar)
+import Data.Monoid (mappend)
 
 takeCallback :: B8.ByteString -> Maybe B8.ByteString
 takeCallback bs | B8.null bs = Nothing
@@ -58,23 +62,51 @@
                                            $ requestHeaders env
                         }
     res <- app env'
-    case (fmap B8.unpack $ lookup "Content-Type" $ responseHeaders res, callback) of
-        (Just "application/json", Just c) -> return $ res
-            { responseHeaders = changeVal "Content-Type" "text/javascript" $ responseHeaders res
-            , responseBody = ResponseEnumerator $ addCallback c $ fromResponseBody $ responseBody res
-            }
-        _ -> return res
-
-addCallback :: B8.ByteString -> Enumerator -> Enumerator
-addCallback cb (Enumerator e) = Enumerator $ \iter a -> do
-    ea' <- iter a $ B8.snoc cb '('
-    case ea' of
-        Left a' -> return $ Left a'
-        Right a' -> do
-            ea'' <- e iter a'
-            case ea'' of
-                Left a'' -> return $ Left a''
-                Right a'' -> iter a'' $ B8.singleton ')'
+    case callback of
+        Nothing -> return res
+        Just c -> go c res
+  where
+    go c r@(ResponseFile _ hs _) = go' c r hs
+    go c r@(ResponseBuilder s hs b) =
+        case checkJSON hs of
+            Nothing -> return r
+            Just hs' -> return $ ResponseBuilder s hs' $
+                copyByteString c
+                `mappend` fromChar '('
+                `mappend` b
+                `mappend` fromChar ')'
+    go c (ResponseEnumerator e) = addCallback c e
+    go' c r hs =
+        case checkJSON hs of
+            Just _ -> addCallback c $ responseEnumerator r
+            Nothing -> return r
+    checkJSON hs =
+        case fmap B8.unpack $ lookup "Content-Type" hs of
+            Just "application/json" -> Just $ fixHeaders hs
+            _ -> Nothing
+    fixHeaders = changeVal "Content-Type" "text/javascript"
+    addCallback :: B8.ByteString -> (forall a. ResponseEnumerator a)
+                -> Iteratee B8.ByteString IO Response
+    addCallback cb e =
+        return $ ResponseEnumerator $ helper
+      where
+        helper f =
+            e helper'
+          where
+            helper' s hs =
+                case checkJSON hs of
+                    Just hs' -> wrap $$ f s hs'
+                    Nothing -> f s hs
+        wrap :: Step Builder IO b -> Iteratee Builder IO b
+        wrap step = joinI $ after (enumList 1 [fromChar ')'])
+                 $$ enumList 1 [copyByteString cb, fromChar '('] step
+        after :: Enumerator Builder IO b -> Enumeratee Builder Builder IO b
+        after enum =
+            loop
+          where
+            loop = checkDone $ continue . step
+            step k EOF = enum (Continue k) >>== return
+            step k s = k s >>== loop
 
 changeVal :: Eq a
           => a
diff --git a/Network/Wai/Middleware/Vhost.hs b/Network/Wai/Middleware/Vhost.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Middleware/Vhost.hs
@@ -0,0 +1,9 @@
+module Network.Wai.Middleware.Vhost (vhost) where
+
+import Network.Wai
+
+vhost :: [(Request -> Bool, Application)] -> Application -> Application
+vhost vhosts def req =
+    case filter (\(b, _) -> b req) vhosts of
+        [] -> def req
+        (_, app):_ -> app req
diff --git a/Network/Wai/Parse.hs b/Network/Wai/Parse.hs
--- a/Network/Wai/Parse.hs
+++ b/Network/Wai/Parse.hs
@@ -4,7 +4,6 @@
 
 module Network.Wai.Parse
     ( parseQueryString
-    , parseCookies
     , parseHttpAccept
     , parseRequestBody
     , Sink (..)
@@ -15,6 +14,9 @@
     , Bound (..)
     , findBound
     , sinkTillBound
+    , killCR
+    , killCRLF
+    , takeLine
 #endif
     ) where
 
@@ -29,6 +31,9 @@
 import System.Directory (removeFile, getTemporaryDirectory)
 import System.IO (hClose, openBinaryTempFile, Handle)
 import Network.Wai
+import Data.Enumerator (Iteratee, yield)
+import qualified Data.Enumerator as E
+import Control.Monad.IO.Class (liftIO)
 
 uncons :: S.ByteString -> Maybe (Word8, S.ByteString)
 uncons s
@@ -89,20 +94,6 @@
     combine :: Word8 -> Word8 -> Word8
     combine a b = shiftL a 4 .|. b
 
--- | Decode the value of an HTTP_COOKIE header into key/value pairs.
-parseCookies :: S.ByteString -> [(S.ByteString, S.ByteString)]
-parseCookies s
-  | S.null s = []
-  | otherwise =
-    let (first, rest) = breakDiscard 59 s -- semicolon
-     in parseCookie first : parseCookies rest
-
-parseCookie :: S.ByteString -> (S.ByteString, S.ByteString)
-parseCookie s =
-    let (key, value) = breakDiscard 61 s -- equals sign
-        key' = S.dropWhile (== 32) key -- space
-     in (key', value)
-
 -- | Parse the HTTP accept string to determine supported content types.
 parseHttpAccept :: S.ByteString -> [S.ByteString]
 parseHttpAccept = map fst
@@ -162,138 +153,106 @@
 
 parseRequestBody :: Sink x y
                  -> Request
-                 -> IO ([Param], [File y])
+                 -> Iteratee S.ByteString IO ([Param], [File y])
 parseRequestBody sink req = do
-    let ctype = do
-          ctype' <- lookup "Content-Type" $ requestHeaders req
-          if urlenc `S.isPrefixOf` ctype'
-              then Just Nothing
-              else if formBound `S.isPrefixOf` ctype'
-                      then Just $ Just $ S.drop (S.length formBound) ctype'
-                      else Nothing
     case ctype of
         Nothing -> return ([], [])
         Just Nothing -> do -- url-encoded
             -- NOTE: in general, url-encoded data will be in a single chunk.
             -- Therefore, I'm optimizing for the usual case by sticking with
             -- strict byte strings here.
-            bs <- sourceToBs $ requestBody req
-            return (parseQueryString bs, [])
+            bs <- E.consume
+            return (parseQueryString $ S.concat bs, [])
         Just (Just bound) -> -- multi-part
             let bound' = S8.pack "--" `S.append` bound
-             in parsePieces sink bound' (S.empty, Just $ requestBody req)
+             in parsePieces sink bound'
   where
     urlenc = S8.pack "application/x-www-form-urlencoded"
     formBound = S8.pack "multipart/form-data; boundary="
-
-sourceToBs :: Source -> IO S.ByteString
-sourceToBs = fmap S.concat . go id
-  where
-    go front (Source src) = do
-        res <- src
-        case res of
-            Nothing -> return $ front []
-            Just (bs, src') -> go (front . (:) bs) src'
-
-type Source' = (S.ByteString, Maybe Source)
+    ctype = do
+      ctype' <- lookup "Content-Type" $ requestHeaders req
+      if urlenc `S.isPrefixOf` ctype'
+          then Just Nothing
+          else if formBound `S.isPrefixOf` ctype'
+                  then Just $ Just $ S.drop (S.length formBound) ctype'
+                  else Nothing
 
-takeLine :: Source' -> IO (Maybe (S.ByteString, Source'))
-takeLine (s, msrc)
-    | S.null s = case msrc of
-                    Nothing -> return Nothing
-                    Just (Source src) -> do
-                        res <- src
-                        case res of
-                            Nothing -> return Nothing
-                            Just (x, y) -> takeLine (x, Just y)
-takeLine (s, msrc) =
-    let (x, y) = S.break (== 10) s -- newline
-     in if S.null y
-            then do
-                case msrc of
-                    Nothing -> return $ Just (x, (y, msrc))
-                    Just (Source src) -> do
-                        res <- src
-                        case res of
-                            Nothing -> return $ Just (x, (y, Nothing))
-                            Just (s', src') ->
-                                takeLine (s `S.append` s', Just src')
-            else return $ Just (killCarriage x, (S.drop 1 y, msrc))
-  where
-    killCarriage bs
-      | S.null bs = bs
-      | S.last bs == 13 = S.init bs -- carriage return
-      | otherwise = bs
+takeLine :: Iteratee S.ByteString IO (Maybe S.ByteString)
+takeLine = do
+    mbs <- E.head
+    case mbs of
+        Nothing -> return Nothing
+        Just bs ->
+            let (x, y) = S.break (== 10) bs -- LF
+             in if S.null y
+                    then do
+                        x' <- takeLine
+                        case x' of
+                            Nothing -> return $ Just $ killCR x
+                            Just x'' -> return $ Just $ killCR $ S.append x x''
+                    else do
+                        E.yield () $ E.Chunks [S.drop 1 y]
+                        return $ Just $ killCR x
 
-takeLines :: Source' -> IO (Maybe ([S.ByteString], Source'))
-takeLines src = do
-    res <- takeLine src
+takeLines :: Iteratee S.ByteString IO [S.ByteString]
+takeLines = do
+    res <- takeLine
     case res of
-        Nothing -> return Nothing
-        Just (l, src') ->
-            if S.null l
-                then return $ Just ([], src')
-                else do
-                    res' <- takeLines src'
-                    case res' of
-                        Nothing -> return $ Just ([l], src')
-                        Just (ls, src'') -> return $ Just (l : ls, src'')
+        Nothing -> return []
+        Just l
+            | S.null l -> return []
+            | otherwise -> do
+                ls <- takeLines
+                return $ l : ls
 
-parsePieces :: Sink x y -> S.ByteString -> Source'
-            -> IO ([Param], [File y])
-parsePieces sink bound src = do
-    res <- takeLine src
-    src' <- case res of
-                Nothing -> return (S.empty, Nothing)
-                -- The _bs here should only contain boundary information
-                Just (_bs, src') -> return src'
-    res' <- takeLines src'
+parsePieces :: Sink x y -> S.ByteString
+            -> Iteratee S.ByteString IO ([Param], [File y])
+parsePieces sink bound = do
+    _boundLine <- takeLine
+    res' <- takeLines
     case res' of
-        Nothing -> return ([], [])
-        Just (ls, src'') -> do
-            let ls' = map parsePair ls
+        [] -> return ([], [])
+        _ -> do
+            let ls' = map parsePair res'
             let x = do
                     cd <- lookup contDisp ls'
                     let ct = lookup contType ls'
                     let attrs = parseAttrs cd
-                    let nameBS = S8.pack "name"
-                    name <- lookup nameBS attrs
-                    let fnBS = S8.pack "filename"
-                    return (ct, name, lookup fnBS attrs)
+                    name <- lookup "name" attrs
+                    return (ct, name, lookup "filename" attrs)
             case x of
                 Just (mct, name, Just filename) -> do
                     let ct = fromMaybe "application/octet-stream" mct
-                    seed <- sinkInit sink
-                    (seed', wasFound, msrc''') <-
-                        sinkTillBound bound src'' (sinkAppend sink) seed
-                    y <- sinkClose sink seed'
+                    seed <- liftIO $ sinkInit sink
+                    (seed', wasFound) <-
+                        sinkTillBound bound (sinkAppend sink) seed
+                    y <- liftIO $ sinkClose sink seed'
                     let fi = FileInfo filename ct y
                     let y' = (name, fi)
                     (xs, ys) <-
                         if wasFound
-                            then parsePieces sink bound msrc'''
+                            then parsePieces sink bound
                             else return ([], [])
                     return (xs, y' : ys)
                 Just (_ct, name, Nothing) -> do
                     let seed = id
                     let iter front bs = return $ front . (:) bs
-                    (front, wasFound, msrc''') <-
-                        sinkTillBound bound src'' iter seed
+                    (front, wasFound) <-
+                        sinkTillBound bound iter seed
                     let bs = S.concat $ front []
                     let x' = (name, qsDecode bs)
                     (xs, ys) <-
                         if wasFound
-                            then parsePieces sink bound msrc'''
+                            then parsePieces sink bound
                             else return ([], [])
                     return (x' : xs, ys)
                 _ -> do
                     -- ignore this part
                     let seed = ()
                         iter () _ = return ()
-                    ((), wasFound, msrc''') <-
-                        sinkTillBound bound src'' iter seed
+                    ((), wasFound) <- sinkTillBound bound iter seed
                     if wasFound
-                        then parsePieces sink bound msrc'''
+                        then parsePieces sink bound
                         else return ([], [])
   where
     contDisp = S8.pack "Content-Disposition"
@@ -325,56 +284,58 @@
         | otherwise = True
 
 sinkTillBound :: S.ByteString
-              -> Source'
               -> (x -> S.ByteString -> IO x)
               -> x
-              -> IO (x, Bool, Source')
-sinkTillBound bound (bs, msrc) iter seed = do
-    case findBound bound bs of
+              -> Iteratee S.ByteString IO (x, Bool)
+sinkTillBound bound iter seed = do
+    mbs <- E.head
+    case mbs of
+        Nothing -> return (seed, False)
+        Just bs -> go bs
+  where
+    go bs =
+        case findBound bound bs of
+            FoundBound before after -> do
+                let before' = killCRLF before
+                seed' <- liftIO $ iter seed before'
+                yield () $ E.Chunks [after]
+                return (seed', True)
+            PartialBound -> do
+                mbs <- E.head
+                case mbs of
+                    Nothing -> do
+                        seed' <- liftIO $ iter seed bs
+                        return (seed', False)
+                    Just bs2 -> do
+                        let bs' = bs `S.append` bs2
+                        yield () $ E.Chunks [bs']
+                        sinkTillBound bound iter seed
+            NoBound -> do
+                mbs <- E.head
+                case mbs of
+                    Nothing -> do
+                        seed' <- liftIO $ iter seed bs
+                        sinkTillBound bound iter seed'
+                    Just bs' -> do
+                        -- this funny bit is to catch when there's a
+                        -- newline at the end of the previous chunk
+                        (seed', bs'') <-
+                            if not (S8.null bs) && S8.last bs `elem` "\n\r"
+                                then do
+                                    let (front, back) =
+                                            S.splitAt (S.length bs - 2) bs
+                                    seed' <- liftIO $ iter seed front
+                                    return (seed', back `S.append` bs')
+                                else do
+                                    seed' <- liftIO $ iter seed bs
+                                    return (seed', bs')
+                        yield () $ E.Chunks [bs'']
+                        sinkTillBound bound iter seed'
+        {-
         NoBound -> do
             case msrc of
-                Nothing -> do
-                    seed' <- iter seed bs
-                    return (seed', False, (S.empty, Nothing))
-                Just (Source src) -> do
-                    res <- src
-                    case res of
-                        Nothing -> do
-                            seed' <- iter seed bs
-                            return (seed', False, (S.empty, Nothing))
                         Just (bs', src') -> do
-                            -- this funny bit is to catch when there's a
-                            -- newline at the end of the previous chunk
-                            (seed', bs'') <-
-                                if not (S8.null bs) && S8.last bs `elem` "\n\r"
-                                    then do
-                                        let (front, back) =
-                                                S.splitAt (S.length bs - 2) bs
-                                        seed' <- iter seed front
-                                        return (seed', back `S.append` bs')
-                                    else do
-                                        seed' <- iter seed bs
-                                        return (seed', bs')
-                            sinkTillBound bound (bs'', Just src') iter seed'
-        FoundBound before after -> do
-            let before' = killCRLF before
-            seed' <- iter seed before'
-            return (seed', True, (after, msrc))
-        PartialBound -> do
-            -- not so efficient, but hopefully the unusual case
-            case msrc of
-                Nothing -> do
-                    seed' <- iter seed bs
-                    return (seed', False, (S.empty, Nothing))
-                Just (Source src) -> do
-                    res <- src
-                    case res of
-                        Nothing -> do
-                            seed' <- iter seed bs
-                            return (seed', False, (S.empty, Nothing))
-                        Just (bs', src') -> do
-                            let bs'' = bs `S.append` bs'
-                            sinkTillBound bound (bs'', Just src') iter seed
+        -}
 
 parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]
 parseAttrs = map go . S.split 59 -- semicolon
@@ -389,10 +350,10 @@
 
 killCRLF :: S.ByteString -> S.ByteString
 killCRLF bs
-    | S.null bs || S8.last bs /= '\n' = bs
+    | S.null bs || S.last bs /= 10 = bs -- line feed
     | otherwise = killCR $ S.init bs
 
 killCR :: S.ByteString -> S.ByteString
 killCR bs
-    | S.null bs || S8.last bs /= '\r' = bs
+    | S.null bs || S.last bs /= 13 = bs -- carriage return
     | otherwise = S.init bs
diff --git a/Network/Wai/Zlib.hs b/Network/Wai/Zlib.hs
--- a/Network/Wai/Zlib.hs
+++ b/Network/Wai/Zlib.hs
@@ -1,51 +1,40 @@
 module Network.Wai.Zlib (compress) where
 
-import Prelude
-import Network.Wai
-import Data.ByteString (ByteString)
+import Prelude hiding (head)
+import Data.Enumerator
+    ( Enumeratee, checkDone, Stream (..)
+    , (>>==), head, ($$), joinI
+    )
+import Blaze.ByteString.Builder (Builder, fromByteString)
+import Blaze.ByteString.Builder.Enumerator (builderToByteString)
+import Control.Monad.IO.Class (liftIO)
 
 import Codec.Zlib
 
-compress :: Enumerator -> Enumerator
-compress enum =
-    Enumerator $ \iter acc -> do
-        def <- initDeflate 7 $ WindowBits 31
-        compressInner iter acc enum def
-
-compressInner :: (acc -> ByteString -> IO (Either acc acc))
-              -> acc
-              -> Enumerator
-              -> Deflate
-              -> IO (Either acc acc)
-compressInner iter acc enum def = do
-    eacc <- runEnumerator enum (compressIter iter def) acc
-    case eacc of
-        Left acc' -> return $ Left acc'
-        Right acc' -> finishStream iter def acc'
-
-finishStream :: (acc -> ByteString -> IO (Either acc acc))
-             -> Deflate
-             -> acc
-             -> IO (Either acc acc)
-finishStream iter def acc = finishDeflate def $ drain iter acc
-
-compressIter :: (acc -> ByteString -> IO (Either acc acc))
-             -> Deflate
-             -> acc
-             -> ByteString
-             -> IO (Either acc acc)
-compressIter iter def acc bsI = withDeflateInput def bsI $ drain iter acc
-
-drain :: (acc -> ByteString -> IO (Either acc acc))
-      -> acc
-      -> IO (Maybe ByteString)
-      -> IO (Either acc acc)
-drain iter acc pop = do
-    mbs <- pop
-    case mbs of
-        Nothing -> return $ Right acc
-        Just bs -> do
-            eacc' <- iter acc bs
-            case eacc' of
-                Left acc' -> return $ Left acc'
-                Right acc' -> drain iter acc' pop
+-- Note: this function really should return a stream of ByteStrings, but the
+-- WAI protocol needs Builders anyway.
+compress :: Enumeratee Builder Builder IO a
+compress step0 = joinI $ builderToByteString $$ do
+    def <- liftIO $ initDeflate 7 $ WindowBits 31
+    loop def step0
+  where
+    loop def = checkDone $ step def
+    step def k = do
+        minput <- head
+        case minput of
+            Nothing -> do
+                bss <- liftIO $ finishDeflate def drain
+                k (Chunks bss) >>== return
+            Just input -> do
+                bss <- liftIO $ withDeflateInput def input drain
+                case bss of
+                    [] -> step def k
+                    _ -> k (Chunks bss) >>== loop def
+    drain =
+        go id
+      where
+        go front mbs' = do
+            mbs <- mbs'
+            case mbs of
+                Nothing -> return $ map fromByteString $ front []
+                Just bs -> go (front . (:) bs) mbs'
diff --git a/wai-extra.cabal b/wai-extra.cabal
--- a/wai-extra.cabal
+++ b/wai-extra.cabal
@@ -1,5 +1,5 @@
 Name:                wai-extra
-Version:             0.2.4.2
+Version:             0.3.0
 Synopsis:            Provides some basic WAI handlers and middleware.
 Description:         The goal here is to provide common features without many dependencies.
 License:             BSD3
@@ -15,21 +15,25 @@
 Library
   Build-Depends:     base >= 3 && < 5,
                      bytestring >= 0.9 && < 0.10,
-                     wai >= 0.2.0 && < 0.3,
+                     wai >= 0.3.0 && < 0.4,
                      old-locale >= 1.0 && < 1.1,
                      time >= 1.1.4 && < 1.3,
                      network >= 2.2.1.5 && < 2.4,
                      directory >= 1.0.1 && < 1.2,
-                     utf8-string >= 0.3.4 && < 0.4,
-                     zlib-bindings >= 0.0 && < 0.1
+                     zlib-bindings >= 0.0 && < 0.1,
+                     blaze-builder-enumerator >= 0.2 && < 0.3,
+                     transformers >= 0.2 && < 0.3,
+                     enumerator >= 0.4 && < 0.5,
+                     blaze-builder >= 0.2.1.3 && < 0.3
   Exposed-modules:   Network.Wai.Handler.CGI
-                     Network.Wai.Handler.SimpleServer
+                     Network.Wai.Middleware.Autohead
                      Network.Wai.Middleware.CleanPath
+                     Network.Wai.Middleware.Debug
                      Network.Wai.Middleware.Gzip
                      Network.Wai.Middleware.Jsonp
+                     Network.Wai.Middleware.Vhost
                      Network.Wai.Zlib
                      Network.Wai.Parse
-                     Network.Wai.Handler.Helper
   ghc-options:       -Wall
 
 source-repository head