diff --git a/Network/Wai/EventSource.hs b/Network/Wai/EventSource.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/EventSource.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+    A WAI adapter to the HTML5 Server-Sent Events API.
+-}
+module Network.Wai.EventSource (
+    ServerEvent(..),
+    eventSourceAppChan,
+    eventSourceAppIO
+    ) where
+
+import           Blaze.ByteString.Builder (Builder)
+import           Data.Function (fix)
+import           Control.Concurrent.Chan (Chan, dupChan, readChan)
+import           Control.Monad.IO.Class (liftIO)
+import           Network.HTTP.Types (status200)
+import           Network.Wai (Application, Response, responseStream)
+
+import Network.Wai.EventSource.EventStream
+
+-- | Make a new WAI EventSource application reading events from
+-- the given channel.
+eventSourceAppChan :: Chan ServerEvent -> Application
+eventSourceAppChan chan req sendResponse = do
+    chan' <- liftIO $ dupChan chan
+    eventSourceAppIO (readChan chan') req sendResponse
+
+-- | Make a new WAI EventSource application reading events from
+-- the given IO action.
+eventSourceAppIO :: IO ServerEvent -> Application
+eventSourceAppIO src _ sendResponse =
+    sendResponse $ responseStream
+        status200
+        [("Content-Type", "text/event-stream")]
+        $ \sendChunk flush -> fix $ \loop -> do
+            se <- src
+            case eventToBuilder se of
+                Nothing -> return ()
+                Just b  -> sendChunk b >> flush >> loop
diff --git a/Network/Wai/EventSource/EventStream.hs b/Network/Wai/EventSource/EventStream.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/EventSource/EventStream.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+{- code adapted by Mathias Billman originaly from Chris Smith https://github.com/cdsmith/gloss-web -}
+
+{-|
+    Internal module, usually you don't need to use it.
+-}
+module Network.Wai.EventSource.EventStream (
+    ServerEvent(..),
+    eventToBuilder
+    ) where
+
+import Blaze.ByteString.Builder
+import Blaze.ByteString.Builder.Char8
+import Data.Monoid
+
+{-|
+    Type representing a communication over an event stream.  This can be an
+    actual event, a comment, a modification to the retry timer, or a special
+    "close" event indicating the server should close the connection.
+-}
+data ServerEvent
+    = ServerEvent {
+        eventName :: Maybe Builder,
+        eventId   :: Maybe Builder,
+        eventData :: [Builder]
+        }
+    | CommentEvent {
+        eventComment :: Builder
+        }
+    | RetryEvent {
+        eventRetry :: Int
+        }
+    | CloseEvent
+
+
+{-|
+    Newline as a Builder.
+-}
+nl :: Builder
+nl = fromChar '\n'
+
+
+{-|
+    Field names as Builder
+-}
+nameField, idField, dataField, retryField, commentField :: Builder
+nameField = fromString "event:"
+idField = fromString "id:"
+dataField = fromString "data:"
+retryField = fromString "retry:"
+commentField = fromChar ':'
+
+
+{-|
+    Wraps the text as a labeled field of an event stream.
+-}
+field :: Builder -> Builder -> Builder
+field l b = l `mappend` b `mappend` nl
+
+
+{-|
+    Converts a 'ServerEvent' to its wire representation as specified by the
+    @text/event-stream@ content type.
+-}
+eventToBuilder :: ServerEvent -> Maybe Builder
+eventToBuilder (CommentEvent txt) = Just $ field commentField txt
+eventToBuilder (RetryEvent   n)   = Just $ field retryField (fromShow n)
+eventToBuilder (CloseEvent)       = Nothing
+eventToBuilder (ServerEvent n i d)= Just $
+    (name n $ evid i $ mconcat (map (field dataField) d)) `mappend` nl
+  where
+    name Nothing  = id
+    name (Just n') = mappend (field nameField n')
+    evid Nothing  = id
+    evid (Just i') = mappend (field idField   i')
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
@@ -13,8 +13,8 @@
 import Network.Wai
 import Network.Wai.Internal
 import Network.Socket (getAddrInfo, addrAddress)
+import Data.IORef
 import Data.Maybe (fromMaybe)
-import Control.Exception (mask)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as L
 import Control.Arrow ((***))
@@ -22,17 +22,17 @@
 import qualified System.IO
 import qualified Data.String as String
 import Data.Monoid (mconcat, mempty)
-import Blaze.ByteString.Builder (fromByteString, toLazyByteString)
+import Blaze.ByteString.Builder (fromByteString, toLazyByteString, flush)
 import Blaze.ByteString.Builder.Char8 (fromChar, fromString)
-import Data.Conduit.Blaze (builderToByteStringFlush)
-import Control.Monad.IO.Class (liftIO)
 import Data.ByteString.Lazy.Internal (defaultChunkSize)
 import System.IO (Handle)
 import Network.HTTP.Types (Status (..))
 import qualified Network.HTTP.Types as H
 import qualified Data.CaseInsensitive as CI
 import Data.Monoid (mappend)
-import Data.Conduit
+import qualified Data.Streaming.Blaze as Blaze
+import Data.Function (fix)
+import Control.Monad (unless, void)
 
 #if WINDOWS
 import System.Environment (getEnvironment)
@@ -76,7 +76,7 @@
 -- stick with 'run' or 'runSendfile'.
 runGeneric
      :: [(String, String)] -- ^ all variables
-     -> (Int -> Source IO B.ByteString) -- ^ responseBody of input
+     -> (Int -> IO (IO B.ByteString)) -- ^ responseBody of input
      -> (B.ByteString -> IO ()) -- ^ destination for output
      -> Maybe B.ByteString -- ^ does the server support the X-Sendfile header?
      -> Application
@@ -98,40 +98,48 @@
                 "https" -> True
                 _ -> False
     addrs <- getAddrInfo Nothing (Just remoteHost') Nothing
+    requestBody' <- inputH contentLength
     let addr =
             case addrs of
                 a:_ -> addrAddress a
                 [] -> error $ "Invalid REMOTE_ADDR or REMOTE_HOST: " ++ remoteHost'
-    mask $ \restore -> do
-        let reqHeaders = map (cleanupVarName *** B.pack) vars
-            env = Request
-                { requestMethod = rmethod
-                , rawPathInfo = B.pack pinfo
-                , pathInfo = H.decodePathSegments $ B.pack pinfo
-                , rawQueryString = B.pack qstring
-                , queryString = H.parseQuery $ B.pack qstring
-                , requestHeaders = reqHeaders
-                , isSecure = isSecure'
-                , remoteHost = addr
-                , httpVersion = H.http11 -- FIXME
-                , requestBody = inputH contentLength
-                , vault = mempty
-                , requestBodyLength = KnownLength $ fromIntegral contentLength
-                , requestHeaderHost = lookup "host" reqHeaders
-                , requestHeaderRange = lookup "range" reqHeaders
-                }
-        -- FIXME worry about exception?
-        res <- restore $ app env
+        reqHeaders = map (cleanupVarName *** B.pack) vars
+        env = Request
+            { requestMethod = rmethod
+            , rawPathInfo = B.pack pinfo
+            , pathInfo = H.decodePathSegments $ B.pack pinfo
+            , rawQueryString = B.pack qstring
+            , queryString = H.parseQuery $ B.pack qstring
+            , requestHeaders = reqHeaders
+            , isSecure = isSecure'
+            , remoteHost = addr
+            , httpVersion = H.http11 -- FIXME
+            , requestBody = requestBody'
+            , vault = mempty
+            , requestBodyLength = KnownLength $ fromIntegral contentLength
+            , requestHeaderHost = lookup "host" reqHeaders
+            , requestHeaderRange = lookup "range" reqHeaders
+            }
+    void $ app env $ \res ->
         case (xsendfile, res) of
-            (Just sf, ResponseFile s hs fp Nothing) ->
-                restore $ mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp
+            (Just sf, ResponseFile s hs fp Nothing) -> do
+                mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp
+                return ResponseReceived
             _ -> do
-                let (s, hs, wb) = responseToSource res
-                wb $ \b ->
-                    let src = do
-                            yield (Chunk $ headers s hs `mappend` fromChar '\n')
-                            b
-                     in src $$ builderSink
+                let (s, hs, wb) = responseToStream res
+                (blazeRecv, blazeFinish) <- Blaze.newBlazeRecv Blaze.defaultStrategy
+                wb $ \b -> do
+                    let sendBuilder builder = do
+                            popper <- blazeRecv builder
+                            fix $ \loop -> do
+                                bs <- popper
+                                unless (B.null bs) $ do
+                                    outputH bs
+                                    loop
+                    sendBuilder $ headers s hs `mappend` fromChar '\n'
+                    b sendBuilder (sendBuilder flush)
+                blazeFinish >>= maybe (return ()) outputH
+                return ResponseReceived
   where
     headers s hs = mconcat (map header $ status s : map header' (fixHeaders hs))
     status (Status i m) = (fromByteString "Status", mconcat
@@ -153,13 +161,6 @@
         , fromByteString sf
         , fromByteString " not supported"
         ]
-    bsSink = await >>= maybe (return ()) push
-    push (Chunk bs) = do
-        liftIO $ outputH bs
-        bsSink
-    -- FIXME actually flush?
-    push Flush = bsSink
-    builderSink = builderToByteStringFlush =$ bsSink
     fixHeaders h =
         case lookup "content-type" h of
             Nothing -> ("Content-Type", "text/html; charset=utf-8") : h
@@ -178,19 +179,19 @@
     helper' (x:rest) = toLower x : helper' rest
     helper' [] = []
 
-requestBodyHandle :: Handle -> Int -> Source IO B.ByteString
+requestBodyHandle :: Handle -> Int -> IO (IO B.ByteString)
 requestBodyHandle h = requestBodyFunc $ \i -> do
     bs <- B.hGet h i
     return $ if B.null bs then Nothing else Just bs
 
-requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> Source IO B.ByteString
-requestBodyFunc get =
-    loop
-  where
-    loop 0 = return ()
-    loop count = do
-        mbs <- liftIO $ get $ min count defaultChunkSize
-        let count' = count - maybe 0 B.length mbs
-        case mbs of
-            Nothing -> return ()
-            Just bs -> yield bs >> loop count'
+requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> IO (IO B.ByteString)
+requestBodyFunc get count0 = do
+    ref <- newIORef count0
+    return $ do
+        count <- readIORef ref
+        if count <= 0
+            then return B.empty
+            else do
+                mbs <- get $ min count defaultChunkSize
+                writeIORef ref $ count - maybe 0 B.length mbs
+                return $ fromMaybe B.empty mbs
diff --git a/Network/Wai/Middleware/Autohead.hs b/Network/Wai/Middleware/Autohead.hs
--- a/Network/Wai/Middleware/Autohead.hs
+++ b/Network/Wai/Middleware/Autohead.hs
@@ -4,17 +4,12 @@
 module Network.Wai.Middleware.Autohead (autohead) where
 
 import Network.Wai
-import Network.Wai.Internal
 import Data.Monoid (mempty)
 
 autohead :: Middleware
-autohead app req
-    | requestMethod req == "HEAD" = do
-        res <- app req { requestMethod = "GET" }
-        let go (ResponseFile s hs _ _) = ResponseBuilder s hs mempty
-            go (ResponseBuilder s hs _) = ResponseBuilder s hs mempty
-            go (ResponseSource s hs _) = ResponseBuilder s hs mempty
-            go (ResponseRaw raw r) = ResponseRaw raw (go r)
-        return (go res)
-    | otherwise = app req
+autohead app req sendResponse
+    | requestMethod req == "HEAD" = app req { requestMethod = "GET" } $ \res -> do
+        let (s, hs, _) = responseToStream res
+        sendResponse $ responseBuilder s hs mempty
+    | otherwise = app req sendResponse
 
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
@@ -14,10 +14,10 @@
           -> B.ByteString
           -> ([Text] -> Application)
           -> Application
-cleanPath splitter prefix app env =
+cleanPath splitter prefix app env sendResponse =
     case splitter $ pathInfo env of
-        Right pieces -> app pieces env
-        Left p -> return
+        Right pieces -> app pieces env sendResponse
+        Left p -> sendResponse
                 $ responseLBS status301
                   [("Location", mconcat [prefix, p, suffix])]
                 $ L.empty
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
@@ -28,20 +28,23 @@
 import Data.Maybe (fromMaybe, isJust)
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString as S
-import Data.Default
+import Data.Default.Class
 import Network.HTTP.Types (Status, Header)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Resource (runResourceT)
 import System.Directory (doesFileExist, createDirectoryIfMissing)
-import qualified Data.Conduit as C
-import qualified Data.Conduit.Zlib as CZ
-import qualified Data.Conduit.Binary as CB
-import qualified Data.Conduit.List as CL
-import Data.Conduit.Blaze (builderToByteStringFlush)
 import Blaze.ByteString.Builder (fromByteString)
 import Control.Exception (try, SomeException)
 import qualified Data.Set as Set
 import Network.Wai.Internal
+import qualified Data.Streaming.Blaze as B
+import qualified Data.Streaming.Zlib as Z
+import qualified Blaze.ByteString.Builder as Blaze
+import Control.Monad (unless)
+import Data.Function (fix)
+import Control.Exception (throwIO)
+import qualified System.IO as IO
+import Data.ByteString.Lazy.Internal (defaultChunkSize)
 
 data GzipSettings = GzipSettings
     { gzipFiles :: GzipFiles
@@ -74,20 +77,19 @@
 --
 -- * Only compress if the response is above a certain size.
 gzip :: GzipSettings -> Middleware
-gzip set app env = do
-    res <- app env
+gzip set app env sendResponse = app env $ \res ->
     case res of
-        ResponseFile{} | gzipFiles set == GzipIgnore -> return res
+        ResponseFile{} | gzipFiles set == GzipIgnore -> sendResponse res
         _ -> if "gzip" `elem` enc && not isMSIE6 && not (isEncoded res)
                 then
                     case (res, gzipFiles set) of
                         (ResponseFile s hs file Nothing, GzipCacheFolder cache) ->
                             case lookup "content-type" hs of
                                 Just m
-                                    | gzipCheckMime set m -> liftIO $ compressFile s hs file cache
-                                _ -> return res
-                        _ -> return $ compressE set res
-                else return res
+                                    | gzipCheckMime set m -> compressFile s hs file cache sendResponse
+                                _ -> sendResponse res
+                        _ -> compressE set res sendResponse
+                else sendResponse res
   where
     enc = fromMaybe [] $ (splitCommas . S8.unpack)
                     `fmap` lookup "Accept-Encoding" (requestHeaders env)
@@ -95,22 +97,38 @@
     isMSIE6 = "MSIE 6" `S.isInfixOf` ua
     isEncoded res = isJust $ lookup "Content-Encoding" $ responseHeaders res
 
-compressFile :: Status -> [Header] -> FilePath -> FilePath -> IO Response
-compressFile s hs file cache = do
+compressFile :: Status -> [Header] -> FilePath -> FilePath -> (Response -> IO a) -> IO a
+compressFile s hs file cache sendResponse = do
     e <- doesFileExist tmpfile
     if e
         then onSucc
         else do
             createDirectoryIfMissing True cache
-            x <-
-               try $ runResourceT $ CB.sourceFile file
-                C.$$ CZ.gzip C.=$ CB.sinkFile tmpfile
-            either onErr (const onSucc) x
+            x <- try $
+                 IO.withBinaryFile file IO.ReadMode $ \inH ->
+                 IO.withBinaryFile tmpfile IO.WriteMode $ \outH -> do
+                    deflate <- Z.initDeflate 7 $ Z.WindowBits 31
+                    -- FIXME this code should write to a temporary file, then
+                    -- rename to the final file
+                    let goPopper popper = fix $ \loop -> do
+                            res <- popper
+                            case res of
+                                Z.PRDone -> return ()
+                                Z.PRNext bs -> do
+                                    S.hPut outH bs
+                                    loop
+                                Z.PRError e -> throwIO e
+                    fix $ \loop -> do
+                        bs <- S.hGetSome inH defaultChunkSize
+                        unless (S.null bs) $ do
+                            Z.feedDeflate deflate bs >>= goPopper
+                            loop
+                    goPopper $ Z.finishDeflate deflate
+            either onErr (const onSucc) (x :: Either SomeException ()) -- FIXME bad! don't catch all exceptions like that!
   where
-    onSucc = return $ ResponseFile s (fixHeaders hs) tmpfile Nothing
+    onSucc = sendResponse $ responseFile s (fixHeaders hs) tmpfile Nothing
 
-    onErr :: SomeException -> IO Response
-    onErr = const $ return $ ResponseFile s hs file Nothing -- FIXME log the error message
+    onErr _ = sendResponse $ responseFile s hs file Nothing -- FIXME log the error message
 
     tmpfile = cache ++ '/' : map safe file
     safe c
@@ -123,18 +141,42 @@
 
 compressE :: GzipSettings
           -> Response
-          -> Response
-compressE set res =
+          -> (Response -> IO a)
+          -> IO a
+compressE set res sendResponse =
     case lookup "content-type" hs of
         Just m | gzipCheckMime set m ->
             let hs' = fixHeaders hs
-             in ResponseSource s hs' $ \f -> wb $ \b -> f $
-                                       b C.$= builderToByteStringFlush
-                                         C.$= CZ.compressFlush 1 (CZ.WindowBits 31)
-                                         C.$= CL.map (fmap fromByteString)
-        _ -> res
+             in wb $ \body -> sendResponse $ responseStream s hs' $ \sendChunk flush -> do
+                    (blazeRecv, blazeFinish) <- B.newBlazeRecv B.defaultStrategy
+                    deflate <- Z.initDeflate 1 (Z.WindowBits 31)
+                    let sendBuilder builder = do
+                            popper <- blazeRecv builder
+                            fix $ \loop -> do
+                                bs <- popper
+                                unless (S.null bs) $ do
+                                    sendBS bs
+                                    loop
+                        sendBS bs = Z.feedDeflate deflate bs >>= deflatePopper
+                        flushBuilder = do
+                            sendBuilder Blaze.flush
+                            deflatePopper $ Z.flushDeflate deflate
+                            flush
+                        deflatePopper popper = fix $ \loop -> do
+                            res <- popper
+                            case res of
+                                Z.PRDone -> return ()
+                                Z.PRNext bs' -> do
+                                    sendChunk $ fromByteString bs'
+                                    loop
+                                Z.PRError e -> throwIO e
+
+                    body sendBuilder flushBuilder
+                    sendBuilder Blaze.flush
+                    deflatePopper $ Z.finishDeflate deflate
+        _ -> sendResponse res
   where
-    (s, hs, wb) = responseToSource res
+    (s, hs, wb) = responseToStream res
 
 -- Remove Content-Length header, since we will certainly have a
 -- different length after gzip compression.
diff --git a/Network/Wai/Middleware/HttpAuth.hs b/Network/Wai/Middleware/HttpAuth.hs
--- a/Network/Wai/Middleware/HttpAuth.hs
+++ b/Network/Wai/Middleware/HttpAuth.hs
@@ -32,12 +32,12 @@
 basicAuth :: CheckCreds
           -> AuthSettings
           -> Middleware
-basicAuth checkCreds AuthSettings {..} app req = do
+basicAuth checkCreds AuthSettings {..} app req sendResponse = do
     isProtected <- authIsProtected req
     allowed <- if isProtected then check else return True
     if allowed
-        then app req
-        else authOnNoAuth authRealm req
+        then app req sendResponse
+        else authOnNoAuth authRealm req sendResponse
   where
     check =
         case lookup "Authorization" $ requestHeaders req of
@@ -83,7 +83,7 @@
 instance IsString AuthSettings where
     fromString s = AuthSettings
         { authRealm = fromString s
-        , authOnNoAuth = \realm _req -> return $ responseLBS
+        , authOnNoAuth = \realm _req f -> f $ responseLBS
             status401
             [ ("Content-Type", "text/plain")
             , ("WWW-Authenticate", S.concat
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
@@ -25,7 +25,6 @@
 import Control.Monad (join)
 import Data.Maybe (fromMaybe)
 import qualified Data.ByteString as S
-import qualified Data.Conduit as C
 import Data.CaseInsensitive (CI)
 import Network.HTTP.Types (Status)
 
@@ -37,7 +36,7 @@
 -- having a content type of \"text\/javascript\" and calling the specified
 -- callback function.
 jsonp :: Middleware
-jsonp app env = do
+jsonp app env sendResponse = do
     let accept = fromMaybe B8.empty $ lookup "Accept" $ requestHeaders env
     let callback :: Maybe B8.ByteString
         callback =
@@ -52,15 +51,15 @@
                                            "application/json"
                                            $ requestHeaders env
                         }
-    res <- app env'
-    return $ case callback of
-        Nothing -> res
-        Just c -> go c res
+    app env' $ \res ->
+        case callback of
+            Nothing -> sendResponse res
+            Just c -> go c res
   where
     go c r@(ResponseBuilder s hs b) =
-        case checkJSON hs of
+        sendResponse $ case checkJSON hs of
             Nothing -> r
-            Just hs' -> ResponseBuilder s hs' $
+            Just hs' -> responseBuilder s hs' $
                 copyByteString c
                 `mappend` fromChar '('
                 `mappend` b
@@ -68,9 +67,9 @@
     go c r =
         case checkJSON hs of
             Just hs' -> addCallback c s hs' wb
-            Nothing -> r
+            Nothing -> sendResponse r
       where
-        (s, hs, wb) = responseToSource r
+        (s, hs, wb) = responseToStream r
 
     checkJSON hs =
         case lookup "Content-Type" hs of
@@ -80,16 +79,11 @@
             _ -> Nothing
     fixHeaders = changeVal "Content-Type" "text/javascript"
 
-    addCallback :: ByteString
-                -> Status
-                -> [(CI ByteString, ByteString)]
-                -> (forall b. WithSource IO (C.Flush Builder) b)
-                -> Response
     addCallback cb s hs wb =
-        ResponseSource s hs $ \f -> wb $ \b -> f $
-            C.yield (C.Chunk $ copyByteString cb `mappend` fromChar '(')
-            `mappend` b
-            `mappend` C.yield (C.Chunk $ fromChar ')')
+        wb $ \body -> sendResponse $ responseStream s hs $ \sendChunk flush -> do
+            sendChunk $ copyByteString cb `mappend` fromChar '('
+            body sendChunk flush
+            sendChunk $ fromChar ')'
 
 changeVal :: Eq a
           => a
diff --git a/Network/Wai/Middleware/MethodOverridePost.hs b/Network/Wai/Middleware/MethodOverridePost.hs
--- a/Network/Wai/Middleware/MethodOverridePost.hs
+++ b/Network/Wai/Middleware/MethodOverridePost.hs
@@ -10,9 +10,9 @@
 
 import Network.Wai
 import Network.HTTP.Types           (parseQuery)
-import Data.Monoid                  (mconcat)
-import Data.Conduit.Lazy            (lazyConsume)
-import Data.Conduit.List            (sourceList)
+import Data.Monoid                  (mconcat, mempty)
+import Data.IORef
+import Data.ByteString.Lazy (toChunks)
 
 -- | Allows overriding of the HTTP request method via the _method post string parameter.
 --
@@ -26,13 +26,16 @@
 -- * This middleware only applies when the initial request method is POST.
 --
 methodOverridePost :: Middleware
-methodOverridePost app req = case (requestMethod req, lookup "Content-Type" (requestHeaders req)) of
-  ("POST", Just "application/x-www-form-urlencoded") -> setPost req >>= app
-  _                                                  -> app req
+methodOverridePost app req send =
+    case (requestMethod req, lookup "Content-Type" (requestHeaders req)) of
+      ("POST", Just "application/x-www-form-urlencoded") -> setPost req >>= flip app send
+      _                                                  -> app req send
 
 setPost :: Request -> IO Request
 setPost req = do
-  body <- lazyConsume (requestBody req)
-  case parseQuery (mconcat body) of
-    (("_method", Just newmethod):_) -> return $ req {requestBody = sourceList body, requestMethod = newmethod}
-    _                               -> return $ req {requestBody = sourceList body}
+  body <- (mconcat . toChunks) `fmap` lazyRequestBody req
+  ref <- newIORef body
+  let rb = atomicModifyIORef ref $ \bs -> (mempty, bs)
+  case parseQuery body of
+    (("_method", Just newmethod):_) -> return $ req {requestBody = rb, requestMethod = newmethod}
+    _                               -> return $ req {requestBody = rb}
diff --git a/Network/Wai/Middleware/RequestLogger.hs b/Network/Wai/Middleware/RequestLogger.hs
--- a/Network/Wai/Middleware/RequestLogger.hs
+++ b/Network/Wai/Middleware/RequestLogger.hs
@@ -29,20 +29,16 @@
 import Network.HTTP.Types as H
 import Data.Maybe (fromMaybe)
 import Data.Monoid (mconcat)
-import Data.Time (getCurrentTime, diffUTCTime)
 
 import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File, getRequestBodyType)
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Char8 as S8
 
-import qualified Data.Conduit as C
-import qualified Data.Conduit.List as CL
-
 import System.Console.ANSI
 import Data.IORef.Lifted
 import System.IO.Unsafe
 
-import Data.Default (Default (def))
+import Data.Default.Class (Default (def))
 import Network.Wai.Logger
 import Network.Wai.Middleware.RequestLogger.Internal
 
@@ -97,23 +93,21 @@
             return $ customMiddleware callback getdate formatter
 
 apacheMiddleware :: ApacheLoggerActions -> Middleware
-apacheMiddleware ala app req = do
-    res <- app req
+apacheMiddleware ala app req sendResponse = app req $ \res -> do
     let msize = lookup "content-length" (responseHeaders res) >>= readInt'
         readInt' bs =
             case S8.readInteger bs of
                 Just (i, "") -> Just i
                 _ -> Nothing
     apacheLogger ala req (responseStatus res) msize
-    return res
+    sendResponse res
 
 customMiddleware :: Callback -> IO ZonedDate -> OutputFormatter -> Middleware
-customMiddleware cb getdate formatter app req = do
-    res <- app req
+customMiddleware cb getdate formatter app req sendResponse = app req $ \res -> do
     date <- liftIO getdate
     -- We use Nothing for the response size since we generally don't know it
     liftIO $ cb $ formatter date req (responseStatus res) Nothing
-    return res
+    sendResponse res
 
 -- | Production request logger middleware.
 -- Implemented on top of "logCallback", but prints to 'stdout'
@@ -156,11 +150,13 @@
 --
 -- Example ouput:
 --
--- > GET search :: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
+-- > GET search
+-- > Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
 -- >
 -- > Status: 200 OK. search
 -- >
--- > GET static/css/normalize.css :: text/css,*/*;q=0.1
+-- > GET static/css/normalize.css
+-- > Accept: text/css,*/*;q=0.1
 -- > GET [("LXwioiBG","")]
 -- >
 -- > Status: 304 Not Modified. static/css/normalize.css
@@ -185,13 +181,18 @@
 detailedMiddleware' :: Callback
                     -> IO (BS.ByteString -> [BS.ByteString])
                     -> Middleware
-detailedMiddleware' cb getAddColor app req = do
+detailedMiddleware' cb getAddColor app req sendResponse = do
     let mlen = lookup "content-length" (requestHeaders req) >>= readInt
     (req', body) <-
         case mlen of
             -- log the request body if it is small
             Just len | len <= 2048 -> do
-                 body <- requestBody req C.$$ CL.consume
+                 let loop front = do
+                        bs <- requestBody req
+                        if S8.null bs
+                            then return $ front []
+                            else loop $ front . (bs:)
+                 body <- loop id
                  -- logging the body here consumes it, so fill it back up
                  -- obviously not efficient, but this is the development logger
                  --
@@ -203,14 +204,10 @@
                  -- implementation ensures that each chunk is only returned
                  -- once.
                  ichunks <- newIORef body
-                 let rbody = do
-                        chunks <- readIORef ichunks
+                 let rbody = atomicModifyIORef ichunks $ \chunks ->
                         case chunks of
-                            [] -> return ()
-                            x:xs -> do
-                                writeIORef ichunks xs
-                                C.yield x
-                                rbody
+                            [] -> ([], S8.empty)
+                            x:y -> (y, x)
                  let req' = req { requestBody = rbody }
                  return (req', body)
             _ -> return (req, [])
@@ -236,24 +233,20 @@
         , "\n"
         ]
 
-    t0 <- getCurrentTime
-    rsp <- app req'
-    t1 <- getCurrentTime
+    app req' $ \rsp -> do
 
-    -- log the status of the response
-    -- this is color coordinated with the request logging
-    -- also includes the request path to connect it to the request
-    liftIO $ cb $ mconcat $ map toLogStr $
-        addColor "Status: " ++ statusBS rsp ++
-        [ " "
-        , msgBS rsp
-        , ". "
-        , pack $ show $ diffUTCTime t1 t0
-        , ". "
-        , rawPathInfo req -- if you need help matching the 2 logging statements
-        , "\n"
-        ]
-    return rsp
+        -- log the status of the response
+        -- this is color coordinated with the request logging
+        -- also includes the request path to connect it to the request
+        liftIO $ cb $ mconcat $ map toLogStr $
+            addColor "Status: " ++ statusBS rsp ++
+            [ " "
+            , msgBS rsp
+            , ". "
+            , rawPathInfo req -- if you need help matching the 2 logging statements
+            , "\n"
+            ]
+        sendResponse rsp
   where
     paramsToBS prefix params =
       if null params then ""
@@ -262,7 +255,13 @@
     allPostParams body =
         case getRequestBodyType req of
             Nothing -> return ([], [])
-            Just rbt -> CL.sourceList body C.$$ sinkRequestBody lbsBackEnd rbt
+            Just rbt -> do
+                ichunks <- newIORef body
+                let rbody = atomicModifyIORef ichunks $ \chunks ->
+                        case chunks of
+                            [] -> ([], S8.empty)
+                            x:y -> (y, x)
+                sinkRequestBody lbsBackEnd rbt rbody
 
     emptyGetParam :: (BS.ByteString, Maybe BS.ByteString) -> (BS.ByteString, BS.ByteString)
     emptyGetParam (k, Just v) = (k,v)
diff --git a/Network/Wai/Middleware/Rewrite.hs b/Network/Wai/Middleware/Rewrite.hs
--- a/Network/Wai/Middleware/Rewrite.hs
+++ b/Network/Wai/Middleware/Rewrite.hs
@@ -13,10 +13,10 @@
 
 -- | rewrite based on your own conversion rules
 rewrite :: ([Text] -> H.RequestHeaders -> IO [Text]) -> Middleware
-rewrite convert app req = do
+rewrite convert app req sendResponse = do
   newPathInfo <- liftIO $ convert (pathInfo req) (requestHeaders req)
   let rawPInfo = TE.encodeUtf8 $ T.intercalate "/" newPathInfo
-  app req { pathInfo = newPathInfo, rawPathInfo =  rawPInfo }
+  app req { pathInfo = newPathInfo, rawPathInfo =  rawPInfo } sendResponse
 
 -- | rewrite based on your own conversion rules
 -- Example convert function:
diff --git a/Network/Wai/Middleware/Vhost.hs b/Network/Wai/Middleware/Vhost.hs
--- a/Network/Wai/Middleware/Vhost.hs
+++ b/Network/Wai/Middleware/Vhost.hs
@@ -20,10 +20,10 @@
   redirectIf home (maybe True (BS.isPrefixOf "www") . lookup "host" . requestHeaders)
 
 redirectIf :: Text -> (Request -> Bool) -> Application -> Application
-redirectIf home cond app req =
+redirectIf home cond app req sendResponse =
   if cond req
-    then return $ redirectTo $ TE.encodeUtf8 home
-    else app req
+    then sendResponse $ redirectTo $ TE.encodeUtf8 home
+    else app req sendResponse
 
 redirectTo :: BS.ByteString -> Response
 redirectTo location = responseLBS H.status301
diff --git a/Network/Wai/Parse.hs b/Network/Wai/Parse.hs
--- a/Network/Wai/Parse.hs
+++ b/Network/Wai/Parse.hs
@@ -12,7 +12,6 @@
     , RequestBodyType (..)
     , getRequestBodyType
     , sinkRequestBody
-    , conduitRequestBody
     , BackEnd
     , lbsBackEnd
     , tempFileBackEnd
@@ -38,22 +37,14 @@
 import Data.Word (Word8)
 import Data.Maybe (fromMaybe)
 import Data.List (sortBy)
-import Data.Function (on)
+import Data.Function (on, fix)
 import System.Directory (removeFile, getTemporaryDirectory)
 import System.IO (hClose, openBinaryTempFile)
 import Network.Wai
-import Data.Conduit
-import Data.Conduit.Internal ()
-import qualified Data.Conduit.List as CL
-import qualified Data.Conduit.Binary as CB
-import Control.Monad.IO.Class (liftIO)
 import qualified Network.HTTP.Types as H
-import Data.Either (partitionEithers)
 import Control.Monad (when, unless)
-import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
-import Data.Conduit.Internal (Pipe (NeedInput, HaveOutput), (>+>), withUpstream, injectLeftovers, ConduitM (..))
-import Data.Void (Void)
+import Data.IORef
 
 breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
 breakDiscard w s =
@@ -85,15 +76,22 @@
                 _ -> 1.0
 
 -- | Store uploaded files in memory
-lbsBackEnd :: Monad m => ignored1 -> ignored2 -> Sink S.ByteString m L.ByteString
-lbsBackEnd _ _ = fmap L.fromChunks CL.consume
+lbsBackEnd :: Monad m => ignored1 -> ignored2 -> m S.ByteString -> m L.ByteString
+lbsBackEnd _ _ popper =
+    loop id
+  where
+    loop front = do
+        bs <- popper
+        if S.null bs
+            then return $ L.fromChunks $ front []
+            else loop $ front . (bs:)
 
 -- | Save uploaded files on disk as temporary files
 --
 -- Note: starting with version 2.0, removal of temp files is registered with
 -- the provided @InternalState@. It is the responsibility of the caller to
 -- ensure that this @InternalState@ gets cleaned up.
-tempFileBackEnd :: InternalState -> ignored1 -> ignored2 -> Sink S.ByteString IO FilePath
+tempFileBackEnd :: InternalState -> ignored1 -> ignored2 -> IO S.ByteString -> IO FilePath
 tempFileBackEnd = tempFileBackEndOpts getTemporaryDirectory "webenc.buf"
 
 -- | Same as 'tempFileSink', but use configurable temp folders and patterns.
@@ -102,14 +100,19 @@
                     -> InternalState
                     -> ignored1
                     -> ignored2
-                    -> Sink S.ByteString IO FilePath
-tempFileBackEndOpts getTmpDir pattern internalState _ _ = do
+                    -> IO S.ByteString
+                    -> IO FilePath
+tempFileBackEndOpts getTmpDir pattern internalState _ _ popper = do
     (key, (fp, h)) <- flip runInternalState internalState $ allocate (do
         tempDir <- getTmpDir
         openBinaryTempFile tempDir pattern) (\(_, h) -> hClose h)
     _ <- runInternalState (register $ removeFile fp) internalState
-    CB.sinkHandle h
-    lift $ release key
+    fix $ \loop -> do
+        bs <- popper
+        unless (S.null bs) $ do
+            S.hPut h bs
+            loop
+    release key
     return fp
 
 -- | Information on an uploaded file.
@@ -126,11 +129,12 @@
 -- | Post parameter name and associated file information.
 type File y = (S.ByteString, FileInfo y)
 
--- | A file uploading backend. Takes the parameter name, file name, and content
--- type, and returns a `Sink` for storing the contents.
+-- | A file uploading backend. Takes the parameter name, file name, and a
+-- stream of data.
 type BackEnd a = S.ByteString -- ^ parameter name
               -> FileInfo ()
-              -> Sink S.ByteString IO a
+              -> IO S.ByteString
+              -> IO a
 
 data RequestBodyType = UrlEncoded | Multipart S.ByteString
 
@@ -173,60 +177,99 @@
 parseRequestBody s r =
     case getRequestBodyType r of
         Nothing -> return ([], [])
-        Just rbt -> fmap partitionEithers $ requestBody r $$ conduitRequestBody s rbt =$ CL.consume
+        Just rbt -> sinkRequestBody s rbt (requestBody r)
 
 sinkRequestBody :: BackEnd y
                 -> RequestBodyType
-                -> Sink S.ByteString IO ([Param], [File y])
-sinkRequestBody s r = fmap partitionEithers $ conduitRequestBody s r =$ CL.consume
+                -> IO S.ByteString
+                -> IO ([Param], [File y])
+sinkRequestBody s r body = do
+    ref <- newIORef (id, id)
+    let add x = atomicModifyIORef ref $ \(y, z) ->
+            case x of
+                Left y' -> ((y . (y':), z), ())
+                Right z' -> ((y, z . (z':)), ())
+    conduitRequestBody s r body add
+    (x, y) <- readIORef ref
+    return (x [], y [])
 
 conduitRequestBody :: BackEnd y
                    -> RequestBodyType
-                   -> Conduit S.ByteString IO (Either Param (File y))
-conduitRequestBody _ UrlEncoded = do
+                   -> IO S.ByteString
+                   -> (Either Param (File y) -> IO ())
+                   -> IO ()
+conduitRequestBody _ UrlEncoded rbody add = do
     -- 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 <- CL.consume
-    mapM_ yield $ map Left $ H.parseSimpleQuery $ S.concat bs
-conduitRequestBody backend (Multipart bound) =
-    parsePieces backend $ S8.pack "--" `S.append` bound
+    let loop front = do
+            bs <- rbody
+            if S.null bs
+                then return $ S.concat $ front []
+                else loop $ front . (bs:)
+    bs <- loop id
+    mapM_ (add . Left) $ H.parseSimpleQuery bs
+conduitRequestBody backend (Multipart bound) rbody add =
+    parsePieces backend (S8.pack "--" `S.append` bound) rbody add
 
-takeLine :: Monad m => Consumer S.ByteString m (Maybe S.ByteString)
-takeLine =
+takeLine :: Source -> IO (Maybe S.ByteString)
+takeLine src =
     go id
   where
-    go front = await >>= maybe (close front) (push front)
+    go front = do
+        bs <- readSource src
+        if S.null bs
+            then close front
+            else push front bs
 
-    close front = leftover (front S.empty) >> return Nothing
+    close front = leftover src (front S.empty) >> return Nothing
     push front bs = do
         let (x, y) = S.break (== 10) $ front bs -- LF
          in if S.null y
                 then go $ S.append x
                 else do
-                    when (S.length y > 1) $ leftover $ S.drop 1 y
+                    when (S.length y > 1) $ leftover src $ S.drop 1 y
                     return $ Just $ killCR x
 
-takeLines :: Consumer S.ByteString IO [S.ByteString]
-takeLines = do
-    res <- takeLine
+takeLines :: Source -> IO [S.ByteString]
+takeLines src = do
+    res <- takeLine src
     case res of
         Nothing -> return []
         Just l
             | S.null l -> return []
             | otherwise -> do
-                ls <- takeLines
+                ls <- takeLines src
                 return $ l : ls
 
+data Source = Source (IO S.ByteString) (IORef S.ByteString)
+
+mkSource :: IO S.ByteString -> IO Source
+mkSource f = do
+    ref <- newIORef S.empty
+    return $ Source f ref
+
+readSource :: Source -> IO S.ByteString
+readSource (Source f ref) = do
+    bs <- atomicModifyIORef ref $ \bs -> (S.empty, bs)
+    if S.null bs
+        then f
+        else return bs
+
+leftover :: Source -> S.ByteString -> IO ()
+leftover (Source _ ref) bs = writeIORef ref bs
+
 parsePieces :: BackEnd y
             -> S.ByteString
-            -> ConduitM S.ByteString (Either Param (File y)) IO ()
-parsePieces sink bound =
-    loop
+            -> IO S.ByteString
+            -> (Either Param (File y) -> IO ())
+            -> IO ()
+parsePieces sink bound rbody add =
+    mkSource rbody >>= loop
   where
-    loop = do
-        _boundLine <- takeLine
-        res' <- takeLines
+    loop src = do
+        _boundLine <- takeLine src
+        res' <- takeLines src
         unless (null res') $ do
             let ls' = map parsePair res'
             let x = do
@@ -239,23 +282,23 @@
                 Just (mct, name, Just filename) -> do
                     let ct = fromMaybe "application/octet-stream" mct
                         fi0 = FileInfo filename ct ()
-                    (wasFound, y) <- sinkTillBound' bound name fi0 sink
-                    yield $ Right (name, fi0 { fileContent = y })
-                    when wasFound loop
+                    (wasFound, y) <- sinkTillBound' bound name fi0 sink src
+                    add $ Right (name, fi0 { fileContent = y })
+                    when wasFound (loop src)
                 Just (_ct, name, Nothing) -> do
                     let seed = id
                     let iter front bs = return $ front . (:) bs
-                    (wasFound, front) <- sinkTillBound bound iter seed
+                    (wasFound, front) <- sinkTillBound bound iter seed src
                     let bs = S.concat $ front []
                     let x' = (name, bs)
-                    yield $ Left x'
-                    when wasFound loop
+                    add $ Left x'
+                    when wasFound (loop src)
                 _ -> do
                     -- ignore this part
                     let seed = ()
                         iter () _ = return ()
-                    (wasFound, ()) <- sinkTillBound bound iter seed
-                    when wasFound loop
+                    (wasFound, ()) <- sinkTillBound bound iter seed src
+                    when wasFound (loop src)
       where
         contDisp = S8.pack "Content-Disposition"
         contType = S8.pack "Content-Type"
@@ -295,64 +338,78 @@
                -> S.ByteString
                -> FileInfo ()
                -> BackEnd y
-               -> ConduitM S.ByteString o IO (Bool, y)
-sinkTillBound' bound name fi sink =
-    ConduitM $ anyOutput $
-    conduitTillBound bound >+> withUpstream (fix $ sink name fi)
-  where
-    fix :: Sink S8.ByteString IO y -> Pipe Void S8.ByteString Void Bool IO y
-    fix p = ignoreTerm >+> injectLeftovers (unConduitM p)
-    ignoreTerm = await' >>= maybe (return ()) (\x -> yield' x >> ignoreTerm)
-    await' = NeedInput (return . Just) (const $ return Nothing)
-    yield' = HaveOutput (return ()) (return ())
-
-    anyOutput p = p >+> dropInput
-    dropInput = NeedInput (const dropInput) return
+               -> Source
+               -> IO (Bool, y)
+sinkTillBound' bound name fi sink src = do
+    (next, final) <- wrapTillBound bound src
+    y <- sink name fi next
+    b <- final
+    return (b, y)
 
-conduitTillBound :: Monad m
-                 => S.ByteString -- bound
-                 -> Pipe S.ByteString S.ByteString S.ByteString () m Bool
-conduitTillBound bound =
-    unConduitM $
-    go id
+data WTB = WTBWorking (S.ByteString -> S.ByteString)
+         | WTBDone Bool
+wrapTillBound :: S.ByteString -- ^ bound
+              -> Source
+              -> IO (IO S.ByteString, IO Bool) -- ^ Bool indicates if the bound was found
+wrapTillBound bound src = do
+    ref <- newIORef $ WTBWorking id
+    return (go ref, final ref)
   where
-    go front = await >>= maybe (close front) (push front)
-    close front = do
-        let bs = front S.empty
-        unless (S.null bs) $ yield bs
-        return False
-    push front bs' = do
-        let bs = front bs'
-        case findBound bound bs of
-            FoundBound before after -> do
-                let before' = killCRLF before
-                yield before'
-                leftover after
-                return True
-            NoBound -> do
-                -- don't emit newlines, in case it's part of a bound
-                let (toEmit, front') =
-                        if not (S8.null bs) && S8.last bs `elem` "\r\n"
-                            then let (x, y) = S.splitAt (S.length bs - 2) bs
-                                  in (x, S.append y)
-                            else (bs, id)
-                yield toEmit
-                go front'
-            PartialBound -> go $ S.append bs
+    final ref = do
+        x <- readIORef ref
+        case x of
+            WTBWorking _ -> error "wrapTillBound did not finish"
+            WTBDone y -> return y
 
+    go ref = do
+        state <- readIORef ref
+        case state of
+            WTBDone _ -> return S.empty
+            WTBWorking front -> do
+                bs <- readSource src
+                if S.null bs
+                    then do
+                        writeIORef ref $ WTBDone False
+                        return $ front bs
+                    else push $ front bs
+      where
+        push bs =
+            case findBound bound bs of
+                FoundBound before after -> do
+                    let before' = killCRLF before
+                    leftover src after
+                    writeIORef ref $ WTBDone True
+                    return before'
+                NoBound -> do
+                    -- don't emit newlines, in case it's part of a bound
+                    let (toEmit, front') =
+                            if not (S8.null bs) && S8.last bs `elem` "\r\n"
+                                then let (x, y) = S.splitAt (S.length bs - 2) bs
+                                      in (x, S.append y)
+                                else (bs, id)
+                    writeIORef ref $ WTBWorking front'
+                    if S.null toEmit
+                        then go ref
+                        else return toEmit
+                PartialBound -> do
+                    writeIORef ref $ WTBWorking $ S.append bs
+                    go ref
+
 sinkTillBound :: S.ByteString
               -> (x -> S.ByteString -> IO x)
               -> x
-              -> Consumer S.ByteString IO (Bool, x)
-sinkTillBound bound iter seed0 =
-    ConduitM $
-    (conduitTillBound bound >+> (withUpstream $ ij $ CL.foldM iter' seed0))
-  where
-    iter' a b = liftIO $ iter a b
-    ij (ConduitM p) = ignoreTerm >+> injectLeftovers p
-    ignoreTerm = await' >>= maybe (return ()) (\x -> yield' x >> ignoreTerm)
-    await' = NeedInput (return . Just) (const $ return Nothing)
-    yield' = HaveOutput (return ()) (return ())
+              -> Source
+              -> IO (Bool, x)
+sinkTillBound bound iter seed0 src = do
+    (next, final) <- wrapTillBound bound src
+    let loop seed = do
+            bs <- next
+            if S.null bs
+                then return seed
+                else iter seed bs >>= loop
+    seed <- loop seed0
+    b <- final
+    return (b, seed)
 
 parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]
 parseAttrs = map go . S.split 59 -- semicolon
diff --git a/Network/Wai/Test.hs b/Network/Wai/Test.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Test.hs
@@ -0,0 +1,214 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module Network.Wai.Test
+    ( -- * Session
+      Session
+    , runSession
+      -- * Requests
+    , request
+    , srequest
+    , SRequest (..)
+    , SResponse (..)
+    , defaultRequest
+    , setPath
+    , setRawPathInfo
+      -- * Assertions
+    , assertStatus
+    , assertContentType
+    , assertBody
+    , assertBodyContains
+    , assertHeader
+    , assertNoHeader
+    , WaiTestFailure (..)
+    ) where
+
+import Network.Wai
+import Network.Wai.Internal (ResponseReceived (ResponseReceived))
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.State (StateT, evalStateT)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
+import Control.Monad (unless)
+import Control.DeepSeq (deepseq)
+import Control.Exception (throwIO, Exception)
+import Data.Typeable (Typeable)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as S8
+import Blaze.ByteString.Builder (toLazyByteString)
+import qualified Blaze.ByteString.Builder as B
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Network.HTTP.Types as H
+import Data.CaseInsensitive (CI)
+import qualified Data.ByteString as S
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Data.IORef
+import Data.Monoid (mempty, mappend)
+
+type Session = ReaderT Application (StateT ClientState IO)
+
+data ClientState = ClientState
+    { _clientCookies :: Map ByteString ByteString
+    }
+
+initState :: ClientState
+initState = ClientState Map.empty
+
+runSession :: Session a -> Application -> IO a
+runSession session app = evalStateT (runReaderT session app) initState
+
+data SRequest = SRequest
+    { simpleRequest :: Request
+    , simpleRequestBody :: L.ByteString
+    }
+data SResponse = SResponse
+    { simpleStatus :: H.Status
+    , simpleHeaders :: H.ResponseHeaders
+    , simpleBody :: L.ByteString
+    }
+    deriving (Show, Eq)
+request :: Request -> Session SResponse
+request = srequest . flip SRequest L.empty
+
+-- | Set whole path (request path + query string).
+setPath :: Request -> S8.ByteString -> Request
+setPath req path = req {
+    pathInfo = segments
+  , rawPathInfo = B.toByteString (H.encodePathSegments segments)
+  , queryString = query
+  , rawQueryString = (H.renderQuery True query)
+  }
+  where
+    (segments, query) = H.decodePath path
+
+setRawPathInfo :: Request -> S8.ByteString -> Request
+setRawPathInfo r rawPinfo =
+    let pInfo = dropFrontSlash $ T.split (== '/') $ TE.decodeUtf8 rawPinfo
+    in  r { rawPathInfo = rawPinfo, pathInfo = pInfo }
+  where
+    dropFrontSlash ("":"":[]) = [] -- homepage, a single slash
+    dropFrontSlash ("":path) = path
+    dropFrontSlash path = path
+
+srequest :: SRequest -> Session SResponse
+srequest (SRequest req bod) = do
+    app <- ask
+    refChunks <- liftIO $ newIORef $ L.toChunks bod
+    let req' = req
+            { requestBody = atomicModifyIORef refChunks $ \bss ->
+                case bss of
+                    [] -> ([], S.empty)
+                    x:y -> (y, x)
+            }
+    liftIO $ do
+        ref <- newIORef $ error "runResponse gave no result"
+        ResponseReceived <- app req' (runResponse ref)
+        readIORef ref
+    -- FIXME cookie processing
+    --return sres
+
+runResponse :: IORef SResponse -> Response -> IO ResponseReceived
+runResponse ref res = do
+    refBuilder <- newIORef mempty
+    let add y = atomicModifyIORef refBuilder $ \x -> (x `mappend` y, ())
+    withBody $ \body -> body add (return ())
+    builder <- readIORef refBuilder
+    let lbs = toLazyByteString builder
+        len = L.length lbs
+    -- Force evaluation of the body to have exceptions thrown at the right
+    -- time.
+    seq len $ writeIORef ref $ SResponse s h $ toLazyByteString builder
+    return ResponseReceived
+  where
+    (s, h, withBody) = responseToStream res
+
+assertBool :: String -> Bool -> Session ()
+assertBool s b = unless b $ assertFailure s
+
+assertString :: String -> Session ()
+assertString s = unless (null s) $ assertFailure s
+
+assertFailure :: String -> Session ()
+assertFailure msg = msg `deepseq` liftIO (throwIO (WaiTestFailure msg))
+
+data WaiTestFailure = WaiTestFailure String
+    deriving (Show, Eq, Typeable)
+instance Exception WaiTestFailure
+
+assertContentType :: ByteString -> SResponse -> Session ()
+assertContentType ct SResponse{simpleHeaders = h} =
+    case lookup "content-type" h of
+        Nothing -> assertString $ concat
+            [ "Expected content type "
+            , show ct
+            , ", but no content type provided"
+            ]
+        Just ct' -> assertBool (concat
+            [ "Expected content type "
+            , show ct
+            , ", but received "
+            , show ct'
+            ]) (go ct == go ct')
+  where
+    go = S8.takeWhile (/= ';')
+
+assertStatus :: Int -> SResponse -> Session ()
+assertStatus i SResponse{simpleStatus = s} = assertBool (concat
+    [ "Expected status code "
+    , show i
+    , ", but received "
+    , show sc
+    ]) $ i == sc
+  where
+    sc = H.statusCode s
+
+assertBody :: L.ByteString -> SResponse -> Session ()
+assertBody lbs SResponse{simpleBody = lbs'} = assertBool (concat
+    [ "Expected response body "
+    , show $ L8.unpack lbs
+    , ", but received "
+    , show $ L8.unpack lbs'
+    ]) $ lbs == lbs'
+
+assertBodyContains :: L.ByteString -> SResponse -> Session ()
+assertBodyContains lbs SResponse{simpleBody = lbs'} = assertBool (concat
+    [ "Expected response body to contain "
+    , show $ L8.unpack lbs
+    , ", but received "
+    , show $ L8.unpack lbs'
+    ]) $ strict lbs `S.isInfixOf` strict lbs'
+  where
+    strict = S.concat . L.toChunks
+
+assertHeader :: CI ByteString -> ByteString -> SResponse -> Session ()
+assertHeader header value SResponse{simpleHeaders = h} =
+    case lookup header h of
+        Nothing -> assertString $ concat
+            [ "Expected header "
+            , show header
+            , " to be "
+            , show value
+            , ", but it was not present"
+            ]
+        Just value' -> assertBool (concat
+            [ "Expected header "
+            , show header
+            , " to be "
+            , show value
+            , ", but received "
+            , show value'
+            ]) (value == value')
+
+assertNoHeader :: CI ByteString -> SResponse -> Session ()
+assertNoHeader header SResponse{simpleHeaders = h} =
+    case lookup header h of
+        Nothing -> return ()
+        Just s -> assertString $ concat
+            [ "Unexpected header "
+            , show header
+            , " containing "
+            , show s
+            ]
diff --git a/Network/Wai/UrlMap.hs b/Network/Wai/UrlMap.hs
--- a/Network/Wai/UrlMap.hs
+++ b/Network/Wai/UrlMap.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {- | This module gives you a way to mount applications under sub-URIs.
 For example:
 
@@ -83,14 +84,14 @@
     toApplication = id
 
 instance ToApplication UrlMap where
-    toApplication urlMap = \req ->
+    toApplication urlMap req sendResponse =
         case try (pathInfo req) (unUrlMap urlMap) of
             Just (newPath, app) ->
-                app $ req { pathInfo = newPath
-                          , rawPathInfo = makeRaw newPath
-                          }
+                app (req { pathInfo = newPath
+                         , rawPathInfo = makeRaw newPath
+                         }) sendResponse
             Nothing ->
-                return $ responseLBS
+                sendResponse $ responseLBS
                     status404
                     [("content-type", "text/plain")]
                     "Not found\n"
diff --git a/test/Network/Wai/TestSpec.hs b/test/Network/Wai/TestSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Network/Wai/TestSpec.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Network.Wai.TestSpec (main, spec) where
+
+import           Test.Hspec
+
+import           Network.Wai
+import           Network.Wai.Test
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+  describe "setPath" $ do
+
+    let req = setPath defaultRequest "/foo/bar/baz?foo=23&bar=42&baz"
+
+    it "sets pathInfo" $ do
+      pathInfo req `shouldBe` ["foo", "bar", "baz"]
+
+    it "utf8 path" $
+      pathInfo (setPath defaultRequest "/foo/%D7%A9%D7%9C%D7%95%D7%9D/bar") `shouldBe`
+        ["foo", "שלום", "bar"]
+
+    it "sets rawPathInfo" $ do
+      rawPathInfo req `shouldBe` "/foo/bar/baz"
+
+    it "sets queryString" $ do
+      queryString req `shouldBe` [("foo", Just "23"), ("bar", Just "42"), ("baz", Nothing)]
+
+    it "sets rawQueryString" $ do
+      rawQueryString req `shouldBe` "?foo=23&bar=42&baz"
+
+    context "when path has no query string" $ do
+      it "sets rawQueryString to empty string" $ do
+        rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/test/WaiExtraTest.hs b/test/WaiExtraTest.hs
--- a/test/WaiExtraTest.hs
+++ b/test/WaiExtraTest.hs
@@ -3,7 +3,7 @@
 
 import Test.Hspec
 import Test.HUnit hiding (Test)
-import Data.Monoid (mappend, mempty, (<>))
+import Data.Monoid (mappend, mempty)
 
 import Network.Wai
 import Network.Wai.Test
@@ -30,9 +30,6 @@
 import Network.Wai.Middleware.RequestLogger
 import Codec.Compression.GZip (decompress)
 
-import qualified Data.Conduit as C
-import qualified Data.Conduit.List as CL
-import Data.Conduit.Binary (sourceHandle)
 import Control.Monad.IO.Class (liftIO)
 import Data.Maybe (fromMaybe)
 import Network.HTTP.Types (parseSimpleQuery, status200)
@@ -128,7 +125,13 @@
 parseRequestBody' sink (SRequest req bod) =
     case getRequestBodyType req of
         Nothing -> return ([], [])
-        Just rbt -> CL.sourceList (L.toChunks bod) C.$$ sinkRequestBody sink rbt
+        Just rbt -> do
+            ref <- I.newIORef $ L.toChunks bod
+            let rb = I.atomicModifyIORef ref $ \chunks ->
+                        case chunks of
+                            [] -> ([], S.empty)
+                            x:y -> (y, x)
+            sinkRequestBody sink rbt rb
 
 caseParseRequestBody :: Assertion
 caseParseRequestBody =
@@ -295,7 +298,7 @@
 -}
 
 jsonpApp :: Application
-jsonpApp = jsonp $ const $ return $ responseLBS
+jsonpApp = jsonp $ \_ f -> f $ responseLBS
     status200
     [("Content-Type", "application/json")]
     "{\"foo\":\"bar\"}"
@@ -324,7 +327,7 @@
     assertBody "{\"foo\":\"bar\"}" sres3
 
 gzipApp :: Application
-gzipApp = gzip def $ const $ return $ responseLBS status200
+gzipApp = gzip def $ \_ f -> f $ responseLBS status200
     [("Content-Type", "text/plain")]
     "test"
 
@@ -332,7 +335,7 @@
 -- that the compression is skipped based on the presence of
 -- the Content-Encoding header.
 gzipPrecompressedApp :: Application
-gzipPrecompressedApp = gzip def $ const $ return $ responseLBS status200
+gzipPrecompressedApp = gzip def $ \_ f -> f $ responseLBS status200
     [("Content-Type", "text/plain"), ("Content-Encoding", "gzip")]
     "test"
 
@@ -380,8 +383,8 @@
     assertBody "test" sres1 -- the body is not actually compressed
 
 vhostApp1, vhostApp2, vhostApp :: Application
-vhostApp1 = const $ return $ responseLBS status200 [] "app1"
-vhostApp2 = const $ return $ responseLBS status200 [] "app2"
+vhostApp1 _ f = f $ responseLBS status200 [] "app1"
+vhostApp2 _ f = f $ responseLBS status200 [] "app2"
 vhostApp = vhost
     [ ((== Just "foo.com") . lookup "host" . requestHeaders, vhostApp1)
     ]
@@ -400,7 +403,7 @@
     assertBody "app2" sres2
 
 autoheadApp :: Application
-autoheadApp = autohead $ const $ return $ responseLBS status200
+autoheadApp = autohead $ \_ f -> f $ responseLBS status200
     [("Foo", "Bar")] "body"
 
 caseAutohead :: Assertion
@@ -418,7 +421,7 @@
     assertBody "" sres2
 
 moApp :: Application
-moApp = methodOverride $ \req -> return $ responseLBS status200
+moApp = methodOverride $ \req f -> f $ responseLBS status200
     [("Method", requestMethod req)] ""
 
 caseMethodOverride :: Assertion
@@ -442,7 +445,7 @@
     assertHeader "Method" "PUT" sres3
 
 mopApp :: Application
-mopApp = methodOverridePost $ \req -> return $ responseLBS status200 [("Method", requestMethod req)] ""
+mopApp = methodOverridePost $ \req f -> f $ responseLBS status200 [("Method", requestMethod req)] ""
 
 caseMethodOverridePost :: Assertion
 caseMethodOverridePost = flip runSession mopApp $ do
@@ -468,7 +471,7 @@
     assertHeader "Method" "POST" sres4
 
 aoApp :: Application
-aoApp = acceptOverride $ \req -> return $ responseLBS status200
+aoApp = acceptOverride $ \req f -> f $ responseLBS status200
     [("Accept", fromMaybe "" $ lookup "Accept" $ requestHeaders req)] ""
 
 caseAcceptOverride :: Assertion
@@ -520,7 +523,7 @@
         case getRequestBodyType request' of
             Nothing -> return ([], [])
             Just rbt -> withFile "test/requests/dalvik-request" ReadMode $ \h ->
-                sourceHandle h C.$$ sinkRequestBody lbsBackEnd rbt
+                sinkRequestBody lbsBackEnd rbt $ S.hGetSome h 2048
     lookup "scannedTime" params @?= Just "1.298590056748E9"
     lookup "geoLong" params @?= Just "0"
     lookup "geoLat" params @?= Just "0"
@@ -545,26 +548,21 @@
   where
     params = [("foo", "bar"), ("baz", "bin")]
     -- FIXME change back once we include post parameter output in logging postOutput = T.pack $ "POST \nAccept: \nPOST " ++ (show params)
-    -- the time cannot be known, so match around it
-    postOutput = ("POST / :: \nStatus: 200 OK. 0", "s. /\n")
-    getOutput params' = ("GET /location :: \nGET " <> T.pack (show params') <> "\nStatus: 200 OK. 0", "s. /location\n")
+    postOutput = T.pack $ "POST / :: \nStatus: 200 OK. /\n"
+    getOutput params' = T.pack $ "GET /location :: \nGET " ++ show params' ++ "\nStatus: 200 OK. /location\n"
 
-    debugApp (beginning, ending) req = do
-        iactual <- liftIO $ I.newIORef mempty
-        middleware <- liftIO $ mkRequestLogger def
+    debugApp output' req send = do
+        iactual <- I.newIORef mempty
+        middleware <- mkRequestLogger def
             { destination = Callback $ \strs -> I.modifyIORef iactual $ (`mappend` strs)
             , outputFormat = Detailed False
             }
-        res <- middleware (\_req -> return $ responseLBS status200 [ ] "") req
-        actual <- logToBs <$> liftIO (I.readIORef iactual)
-        liftIO $ do
-          actual `shouldSatisfy` S.isPrefixOf begin
-          actual `shouldSatisfy` S.isSuffixOf end
-
+        res <- middleware (\_req f -> f $ responseLBS status200 [ ] "") req send
+        actual <- I.readIORef iactual
+        assertEqual "debug" output $ logToBs actual
         return res
       where
-        begin = TE.encodeUtf8 $ T.toStrict beginning
-        end   = TE.encodeUtf8 $ T.toStrict ending
+        output = TE.encodeUtf8 $ T.toStrict output'
 
         logToBs = fromLogStr
 
@@ -583,8 +581,8 @@
 
   where
   trivialApp :: S.ByteString -> Application
-  trivialApp name req =
-    return $
+  trivialApp name req f =
+    f $
       responseLBS
         status200
         [ ("content-type", "text/plain")
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:             2.1.1.3
+Version:             3.0.0
 Synopsis:            Provides some basic WAI handlers and middleware.
 Description:         The goal here is to provide common features without many dependencies.
 License:             MIT
@@ -22,7 +22,7 @@
 Library
   Build-Depends:     base                      >= 4 && < 5
                    , bytestring                >= 0.9.1.4
-                   , wai                       >= 2.1      && < 2.2
+                   , wai                       >= 3.0      && < 3.1
                    , old-locale                >= 1.0.0.2  && < 1.1
                    , time                      >= 1.1.4
                    , network                   >= 2.2.1.5
@@ -32,13 +32,9 @@
                    , http-types                >= 0.7
                    , text                      >= 0.7
                    , case-insensitive          >= 0.2
-                   , data-default
+                   , data-default-class
                    , fast-logger               >= 2.1      && < 2.2
                    , wai-logger                >= 2.0      && < 2.2
-                   , conduit                   >= 1.0      && < 1.2
-                   , conduit-extra             >= 0.1      && < 1.2
-                   , zlib-conduit              >= 0.5      && < 1.2
-                   , blaze-builder-conduit     >= 0.5      && < 1.2
                    , ansi-terminal
                    , resourcet                 >= 0.4.6    && < 1.2
                    , void                      >= 0.5
@@ -47,6 +43,8 @@
                    , base64-bytestring
                    , word8
                    , lifted-base               >= 0.1.2
+                   , deepseq
+                   , streaming-commons
 
   if os(windows)
       cpp-options:   -DWINDOWS
@@ -68,6 +66,9 @@
                      Network.Wai.Middleware.HttpAuth
                      Network.Wai.Parse
                      Network.Wai.UrlMap
+                     Network.Wai.Test
+                     Network.Wai.EventSource
+                     Network.Wai.EventSource.EventStream
   other-modules:     Network.Wai.Middleware.RequestLogger.Internal
   ghc-options:       -Wall
 
@@ -79,7 +80,6 @@
 
     build-depends:   base                      >= 4        && < 5
                    , wai-extra
-                   , wai-test                  >= 1.3
                    , hspec                     >= 1.3
                    , HUnit
 
@@ -90,14 +90,22 @@
                    , text
                    , bytestring
                    , directory
-                   , zlib-bindings
                    , blaze-builder             >= 0.2.1.4  && < 0.4
                    , data-default
-                   , conduit
                    , fast-logger               >= 2.1
                    , resourcet
-                   , conduit-extra
     ghc-options:       -Wall
+
+test-suite spec
+    type:            exitcode-stdio-1.0
+    hs-source-dirs:  test
+    main-is:         Spec.hs
+    other-modules:   Network.Wai.TestSpec
+    build-depends:   base                      >= 4        && < 5
+                   , wai-extra
+                   , wai
+                   , hspec >= 1.3
+    ghc-options:     -Wall -Werror
 
 source-repository head
   type:     git