diff --git a/snap-server.cabal b/snap-server.cabal
--- a/snap-server.cabal
+++ b/snap-server.cabal
@@ -1,5 +1,5 @@
 name:           snap-server
-version:        0.7.0.1
+version:        0.8.0
 synopsis:       A fast, iteratee-based, epoll-enabled web server for the Snap Framework
 description:
   Snap is a simple and fast web development framework and server written in
@@ -10,15 +10,6 @@
   server library written in Haskell. Together with the @snap-core@ library upon
   which it depends, it provides a clean and efficient Haskell programming
   interface to the HTTP protocol.
-  .
-  Higher-level facilities for building web applications (like user/session
-  management, component interfaces, data modeling, etc.) are planned but not
-  yet implemented, so this release will mostly be of interest for those who:
-  .
-  * need a fast and minimal HTTP API at roughly the same level of abstraction
-    as Java servlets, or
-  .
-  * are interested in contributing to the Snap Framework project.
 
 license:        BSD3
 license-file:   LICENSE
@@ -111,14 +102,14 @@
     case-insensitive          >= 0.3      && < 0.5,
     containers                >= 0.3      && < 0.5,
     directory-tree            >= 0.10     && < 0.11,
-    enumerator                >= 0.4.13.1 && < 0.5,
+    enumerator                >= 0.4.15   && < 0.5,
     filepath                  >= 1.1      && < 1.4,
     MonadCatchIO-transformers >= 0.2.1    && < 0.3,
     mtl                       >= 2        && < 3,
     murmur-hash               >= 0.1      && < 0.2,
     network                   >= 2.3      && < 2.4,
     old-locale,
-    snap-core                 >= 0.7      && < 0.8,
+    snap-core                 >= 0.8      && < 0.9,
     template-haskell          >= 2.2      && < 2.8,
     text                      >= 0.11     && < 0.12,
     time                      >= 1.0      && < 1.5,
diff --git a/src/Snap/Http/Server.hs b/src/Snap/Http/Server.hs
--- a/src/Snap/Http/Server.hs
+++ b/src/Snap/Http/Server.hs
@@ -1,15 +1,13 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-{-|
-
-The Snap HTTP server is a high performance, epoll-enabled, iteratee-based web
-server library written in Haskell. Together with the @snap-core@ library upon
-which it depends, it provides a clean and efficient Haskell programming
-interface to the HTTP protocol.
-
--}
-
+------------------------------------------------------------------------------
+-- | The Snap HTTP server is a high performance, epoll-enabled, iteratee-based
+-- web server library written in Haskell. Together with the @snap-core@
+-- library upon which it depends, it provides a clean and efficient Haskell
+-- programming interface to the HTTP protocol.
+--
 module Snap.Http.Server
   ( simpleHttpServe
   , httpServe
@@ -19,6 +17,7 @@
   , module Snap.Http.Server.Config
   ) where
 
+------------------------------------------------------------------------------
 import           Control.Applicative
 import           Control.Concurrent (newMVar, withMVar)
 import           Control.Monad
@@ -32,12 +31,14 @@
 import qualified Snap.Internal.Http.Server as Int
 import           Snap.Core
 import           Snap.Util.GZip
+import           Snap.Util.Proxy
 #ifndef PORTABLE
 import           System.Posix.Env
 #endif
 import           System.IO
 import           System.FastLogger
 
+
 ------------------------------------------------------------------------------
 -- | A short string describing the Snap server version
 snapServerVersion :: ByteString
@@ -48,7 +49,8 @@
 -- | Starts serving HTTP requests using the given handler. This function never
 -- returns; to shut down the HTTP server, kill the controlling thread.
 --
--- This function is like 'httpServe' except it doesn't setup compression or
+-- This function is like 'httpServe' except it doesn't setup compression,
+-- reverse proxy address translation (via 'Snap.Util.Proxy.behindProxy'), or
 -- the error handler; this allows it to be used from 'MonadSnap'.
 simpleHttpServe :: MonadSnap m => Config m a -> Snap () -> IO ()
 simpleHttpServe config handler = do
@@ -57,9 +59,11 @@
     mapM_ (output . ("Listening on "++) . show) $ listeners conf
 
     go conf `finally` output "\nShutting down..."
+
   where
     go conf = do
         let tout = fromMaybe 60 $ getDefaultTimeout conf
+
         setUnicodeLocale $ fromJust $ getLocale conf
         withLoggers (fromJust $ getAccessLog conf)
                     (fromJust $ getErrorLog conf) $
@@ -93,6 +97,7 @@
 {-# INLINE simpleHttpServe #-}
 
 
+------------------------------------------------------------------------------
 listeners :: Config m a -> [Int.ListenPort]
 listeners conf = catMaybes [ httpListener, httpsListener ]
   where
@@ -101,12 +106,12 @@
         p    <- getSSLPort conf
         cert <- getSSLCert conf
         key  <- getSSLKey conf
-        return $ Int.HttpsPort b p cert key
+        return $! Int.HttpsPort b p cert key
 
     httpListener = do
         p <- getPort conf
         b <- getBind conf
-        return $ Int.HttpPort b p
+        return $! Int.HttpPort b p
 
 
 ------------------------------------------------------------------------------
@@ -114,10 +119,16 @@
 -- the 'Config' passed in. This function never returns; to shut down the HTTP
 -- server, kill the controlling thread.
 httpServe :: Config Snap a -> Snap () -> IO ()
-httpServe config handler = do
+httpServe config handler0 = do
     conf <- completeConfig config
+    let !handler = chooseProxy conf
     let serve = compress conf . catch500 conf $ handler
     simpleHttpServe conf serve
+
+  where
+    chooseProxy conf = maybe handler0
+                             (\ptype -> behindProxy ptype handler0)
+                             (getProxyType conf)
 {-# INLINE httpServe #-}
 
 
@@ -131,6 +142,7 @@
 compress :: MonadSnap m => Config m a -> m () -> m ()
 compress conf = if fromJust $ getCompression conf then withCompression else id
 {-# INLINE compress #-}
+
 
 ------------------------------------------------------------------------------
 -- | Starts serving HTTP using the given handler. The configuration is read
diff --git a/src/Snap/Http/Server/Config.hs b/src/Snap/Http/Server/Config.hs
--- a/src/Snap/Http/Server/Config.hs
+++ b/src/Snap/Http/Server/Config.hs
@@ -19,6 +19,8 @@
   , commandLineConfig
   , completeConfig
 
+  , optDescrs
+
   , getAccessLog
   , getBackend
   , getBind
@@ -30,6 +32,7 @@
   , getLocale
   , getOther
   , getPort
+  , getProxyType
   , getSSLBind
   , getSSLCert
   , getSSLKey
@@ -47,6 +50,7 @@
   , setLocale
   , setOther
   , setPort
+  , setProxyType
   , setSSLBind
   , setSSLCert
   , setSSLKey
@@ -54,7 +58,7 @@
   , setVerbose
   ) where
 
-
+------------------------------------------------------------------------------
 import           Blaze.ByteString.Builder
 import           Blaze.ByteString.Builder.Char8
 import           Control.Exception (SomeException)
@@ -73,6 +77,7 @@
 import           Snap.Core
 import           Snap.Iteratee ((>==>), enumBuilder)
 import           Snap.Internal.Debug (debug)
+import           Snap.Util.Proxy
 import           System.Console.GetOpt
 import           System.Environment hiding (getEnv)
 #ifndef PORTABLE
@@ -80,7 +85,6 @@
 #endif
 import           System.Exit
 import           System.IO
-
 ------------------------------------------------------------------------------
 import           Snap.Internal.Http.Server (requestErrorMessage)
 
@@ -133,6 +137,7 @@
     , defaultTimeout :: Maybe Int
     , other          :: Maybe a
     , backend        :: Maybe ConfigBackend
+    , proxyType      :: Maybe ProxyType
     }
 
 instance Show (Config m a) where
@@ -151,6 +156,7 @@
                      , "verbose: "        ++ _verbose
                      , "defaultTimeout: " ++ _defaultTimeout
                      , "backend: "        ++ _backend
+                     , "proxyType: "      ++ _proxyType
                      ]
 
       where
@@ -168,6 +174,7 @@
         _verbose        = show $ verbose        c
         _defaultTimeout = show $ defaultTimeout c
         _backend        = show $ backend        c
+        _proxyType      = show $ proxyType      c
 
 
 ------------------------------------------------------------------------------
@@ -196,6 +203,7 @@
         , defaultTimeout = Nothing
         , other          = Nothing
         , backend        = Nothing
+        , proxyType      = Nothing
         }
 
     a `mappend` b = Config
@@ -215,6 +223,7 @@
         , defaultTimeout = ov defaultTimeout a b
         , other          = ov other          a b
         , backend        = ov backend        a b
+        , proxyType      = ov proxyType      a b
         }
       where
         ov f x y = getLast $! (mappend `on` (Last . f)) x y
@@ -251,7 +260,9 @@
 
 
 ------------------------------------------------------------------------------
--- | The hostname of the HTTP server
+-- | The hostname of the HTTP server. This field has the same format as an HTTP
+-- @Host@ header; if a @Host@ header came in with the request, we use that,
+-- otherwise we default to this value specified in the configuration.
 getHostname       :: Config m a -> Maybe ByteString
 getHostname = hostname
 
@@ -263,7 +274,10 @@
 getErrorLog       :: Config m a -> Maybe ConfigLog
 getErrorLog = errorLog
 
--- | The locale to use
+-- | Gets the locale to use. Locales are used on Unix only, to set the
+-- @LANG@\/@LC_ALL@\/etc. environment variable. For instance if you set the
+-- locale to \"@en_US@\", we'll set the relevant environment variables to
+-- \"@en_US.UTF-8@\".
 getLocale         :: Config m a -> Maybe String
 getLocale = locale
 
@@ -312,7 +326,10 @@
 getBackend :: Config m a -> Maybe ConfigBackend
 getBackend = backend
 
+getProxyType :: Config m a -> Maybe ProxyType
+getProxyType = proxyType
 
+
 ------------------------------------------------------------------------------
 setHostname       :: ByteString              -> Config m a -> Config m a
 setHostname x c = c { hostname = Just x }
@@ -362,14 +379,17 @@
 setBackend        :: ConfigBackend           -> Config m a -> Config m a
 setBackend x c = c { backend = Just x }
 
+setProxyType      :: ProxyType               -> Config m a -> Config m a
+setProxyType x c = c { proxyType = Just x }
 
+
 ------------------------------------------------------------------------------
 completeConfig :: (MonadSnap m) => Config m a -> IO (Config m a)
 completeConfig config = do
     when noPort $ hPutStrLn stderr
         "no port specified, defaulting to port 8000"
 
-    return $ cfg `mappend` cfg'
+    return $! cfg `mappend` cfg'
 
   where
     cfg = defaultConfig `mappend` config
@@ -396,10 +416,12 @@
 
 
 ------------------------------------------------------------------------------
-options :: MonadSnap m =>
-           Config m a
-        -> [OptDescr (Maybe (Config m a))]
-options defaults =
+-- | Returns a description of the snap command line options suitable for use
+-- with "System.Console.GetOpt".
+optDescrs :: MonadSnap m =>
+             Config m a         -- ^ the configuration defaults.
+          -> [OptDescr (Maybe (Config m a))]
+optDescrs defaults =
     [ Option [] ["hostname"]
              (ReqArg (Just . setConfig setHostname . bsFromString) "NAME")
              $ "local hostname" ++ defaultC getHostname
@@ -452,10 +474,17 @@
     , Option ['q'] ["quiet"]
              (NoArg $ Just $ setConfig setVerbose False)
              $ "do not print anything to stderr"
+    , Option [] ["proxy"]
+             (ReqArg (\t -> Just $ setConfig setProxyType $ read t)
+                     "X_Forwarded_For")
+             $ concat [ "Set --proxy=X_Forwarded_For if your snap application "
+                      , "is behind an HTTP reverse proxy to ensure that "
+                      , "rqRemoteAddr is set properly."]
     , Option ['h'] ["help"]
              (NoArg Nothing)
              $ "display this help and exit"
     ]
+
   where
     setConfig f c = f c mempty
     conf          = defaultConfig `mappend` defaults
@@ -478,6 +507,7 @@
                . modifyResponseBody
                      (>==> enumBuilder (fromByteString msg))
                $ emptyResponse
+
   where
     smsg req = toByteString $ requestErrorMessage req e
 
@@ -505,7 +535,7 @@
     args <- getArgs
     prog <- getProgName
 
-    let opts = options defaults
+    let opts = optDescrs defaults
 
     result <- either (usage prog opts)
                      return
diff --git a/src/Snap/Internal/Http/Parser.hs b/src/Snap/Internal/Http/Parser.hs
--- a/src/Snap/Internal/Http/Parser.hs
+++ b/src/Snap/Internal/Http/Parser.hs
@@ -85,7 +85,7 @@
             let ver@(!_,!_) = pVer vStr
 
             hdrs    <- pHeaders
-            return $ Just $ IRequest method uri ver hdrs
+            return $! Just $! IRequest method uri ver hdrs
 
   where
     pVer s = if S.isPrefixOf "HTTP/" s
@@ -215,7 +215,7 @@
       else do
           x <- take hex
           crlf
-          return $ Just x
+          return $! Just x
   where
     fromHex :: ByteString -> Int
     fromHex s = Cvt.hex (L.fromChunks [s])
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -29,6 +29,7 @@
 import qualified Data.ByteString.Lazy as L
 import           Data.ByteString.Internal (c2w, w2c)
 import qualified Data.ByteString.Nums.Careless.Int as Cvt
+import           Data.Enumerator.Internal
 import           Data.Int
 import           Data.IORef
 import           Data.List (foldl')
@@ -46,9 +47,9 @@
 import           System.Locale
 ------------------------------------------------------------------------------
 import           System.FastLogger (timestampedLogEntry, combinedLogEntry)
-import           Snap.Core (EscapeHttpException (..))
 import           Snap.Internal.Http.Types
 import           Snap.Internal.Debug
+import           Snap.Internal.Exceptions (EscapeHttpException (..))
 import           Snap.Internal.Http.Parser
 import           Snap.Internal.Http.Server.Date
 
@@ -77,7 +78,7 @@
 -- Note that we won't be bothering end users with this -- the details will be
 -- hidden inside the Snap monad
 type ServerHandler = (ByteString -> IO ())
-                  -> (Int -> IO ())
+                  -> ((Int -> Int) -> IO ())
                   -> Request
                   -> Iteratee ByteString IO (Request,Response)
 
@@ -95,8 +96,9 @@
 
 ------------------------------------------------------------------------------
 instance Show ListenPort where
-    show (HttpPort b p) =
-        concat [ "http://", SC.unpack b, ":", show p, "/" ]
+    show (HttpPort  b p    ) =
+        concat [ "http://" , SC.unpack b, ":", show p, "/" ]
+
     show (HttpsPort b p _ _) =
         concat [ "https://", SC.unpack b, ":", show p, "/" ]
 
@@ -198,7 +200,7 @@
             logE elog "Server.httpServe: BACKEND STOPPED"
 
     --------------------------------------------------------------------------
-    bindPort (HttpPort  baddr port)          = bindHttp  baddr port
+    bindPort (HttpPort  baddr port         ) = bindHttp  baddr port
     bindPort (HttpsPort baddr port cert key) =
         TLS.bindHttps baddr port cert key
 
@@ -263,7 +265,7 @@
         -> Iteratee ByteString IO ()     -- ^ write end of socket
         -> (FilePath -> Int64 -> Int64 -> IO ())
                                          -- ^ sendfile end
-        -> (Int -> IO ())                -- ^ timeout tickler
+        -> ((Int -> Int) -> IO ())       -- ^ timeout tickler
         -> IO ()
 runHTTP defaultTimeout alog elog handler lh sinfo readEnd writeEnd onSendFile
         tickle =
@@ -284,7 +286,8 @@
                      , fromShow $ remoteAddress sinfo
                      , fromByteString "]: "
                      , fromByteString "an exception escaped to toplevel:\n"
-                     , fromShow e ]
+                     , fromShow e
+                     ]
 
     go = do
         buf <- allocBuffer 16384
@@ -312,7 +315,8 @@
             , fromByteString "\nrequest:\n"
             , fromShow $ show req
             , fromByteString "\n"
-            , msgB ]
+            , msgB
+            ]
   where
     msgB = mconcat [
              fromByteString "A web handler threw an exception. Details:\n"
@@ -347,7 +351,7 @@
             -> Buffer                        -- ^ builder buffer
             -> (FilePath -> Int64 -> Int64 -> IO ())
                                              -- ^ sendfile continuation
-            -> (Int -> IO ())                -- ^ timeout tickler
+            -> ((Int -> Int) -> IO ())       -- ^ timeout modifier
             -> ServerHandler                 -- ^ handler procedure
             -> ServerMonad ()
 httpSession defaultTimeout writeEnd' buffer onSendFile tickle handler = do
@@ -359,7 +363,7 @@
     debug "Server.httpSession: receiveRequest finished"
 
     -- successfully got a request, so restart timer
-    liftIO $ tickle defaultTimeout
+    liftIO $ tickle (max defaultTimeout)
 
     case mreq of
       (Just req) -> do
@@ -446,7 +450,8 @@
           mconcat [ fromByteString "httpSession caught an exception during "
                   , fromByteString phase
                   , fromByteString " phase:\n"
-                  , requestErrorMessage req e ]
+                  , requestErrorMessage req e
+                  ]
         throw ExceptionAlreadyCaught
 
 
@@ -468,7 +473,8 @@
                          , fromShow major
                          , fromWord8 $ c2w '.'
                          , fromShow minor
-                         , fromByteString " 100 Continue\r\n\r\n" ]
+                         , fromByteString " 100 Continue\r\n\r\n"
+                         ]
         liftIO $ runIteratee
                    ((enumBS (toByteString hl) >==> enumEOF) $$ writeEnd)
         return ()
@@ -490,7 +496,8 @@
                          , fromWord8 $ c2w '.'
                          , fromShow minor
                          , fromByteString " 411 Length Required\r\n\r\n"
-                         , fromByteString "411 Length Required\r\n" ]
+                         , fromByteString "411 Length Required\r\n"
+                         ]
         liftIO $ runIteratee
                    ((enumBS (toByteString hl) >==> enumEOF) $$ writeEnd)
         return ()
@@ -501,7 +508,8 @@
 receiveRequest writeEnd = do
     debug "receiveRequest: entered"
     mreq <- {-# SCC "receiveRequest/parseRequest" #-} lift $
-            iterateeDebugWrapper "parseRequest" parseRequest
+            iterateeDebugWrapper "parseRequest" $
+            joinI' $ takeNoMoreThan maxHeadersSize $$ parseRequest
     debug "receiveRequest: parseRequest returned"
 
     case mreq of
@@ -510,13 +518,17 @@
           setEnumerator req'
           req  <- parseForm req'
           checkConnectionClose (rqVersion req) (rqHeaders req)
-          return $ Just req
+          return $! Just req
 
       Nothing     -> return Nothing
 
-
   where
     --------------------------------------------------------------------------
+    -- TODO(gdc): make this a policy decision (expose in
+    -- Snap.Http.Server.Config)
+    maxHeadersSize = 256 * 1024
+
+    --------------------------------------------------------------------------
     -- check: did the client specify "transfer-encoding: chunked"? then we
     -- have to honor that.
     --
@@ -613,8 +625,10 @@
                 e st'
 
             liftIO $ writeIORef (rqBody req) $ SomeEnumerator e'
-            return $ req { rqParams = Map.unionWith (++) (rqParams req)
-                                        newParams }
+            return $! req { rqParams = Map.unionWith (++) (rqParams req)
+                                         newParams
+                          , rqPostParams = newParams
+                          }
 
 
     --------------------------------------------------------------------------
@@ -635,30 +649,29 @@
             -- will override in "setEnumerator"
             enum <- liftIO $ newIORef $ SomeEnumerator (enumBS "")
 
-            return $ Request serverName
-                             serverPort
-                             remoteAddr
-                             rport
-                             localAddr
-                             lport
-                             localHostname
-                             secure
-                             hdrs
-                             enum
-                             mbContentLength
-                             method
-                             version
-                             cookies
-                             snapletPath
-                             pathInfo
-                             contextPath
-                             uri
-                             queryString
-                             params
+            return $! Request serverName
+                              serverPort
+                              remoteAddr
+                              rport
+                              localAddr
+                              lport
+                              localHostname
+                              secure
+                              hdrs
+                              enum
+                              mbContentLength
+                              method
+                              version
+                              cookies
+                              pathInfo
+                              contextPath
+                              uri
+                              queryString
+                              params
+                              params
+                              Map.empty
 
       where
-        snapletPath = ""        -- TODO: snaplets in v0.2
-
         dropLeadingSlash s = maybe s f mbS
           where
             f (a,s') = if a == c2w '/' then s' else s
@@ -741,9 +754,14 @@
         outstep <- lift $ runIteratee $
                    iterateeDebugWrapper "countBytes writeEnd" $
                    countBytes writeEnd
+
+        let bufferFunc = if getBufferingMode rsp
+                           then unsafeBuilderToByteString (return buffer)
+                           else I.map (toByteString . (`mappend` flush))
+
         (x,bs) <- mapIter fromByteString toByteString
-                          (enum $$ joinI $ unsafeBuilderToByteString
-                              (return buffer) outstep)
+                          (enum $$ joinI $ bufferFunc outstep)
+
         debug $ "sendResponse: whenEnum: " ++ show bs ++
                 " bytes enumerated"
 
@@ -858,7 +876,7 @@
         {-# SCC "setFileSize" #-}
         do
             fs <- liftM fromIntegral $ liftIO $ getFileSize fp
-            return $ r { rspContentLength = Just fs }
+            return $! r { rspContentLength = Just fs }
 
 
     --------------------------------------------------------------------------
@@ -892,7 +910,7 @@
             z <- case rspBody r'' of
                    (Enum _)                  -> return r''
                    (SendFile f Nothing)      -> setFileSize f r''
-                   (SendFile _ (Just (s,e))) -> return $
+                   (SendFile _ (Just (s,e))) -> return $!
                                                 setContentLength (e-s) r''
 
             case rspContentLength z of
diff --git a/src/Snap/Internal/Http/Server/Backend.hs b/src/Snap/Internal/Http/Server/Backend.hs
--- a/src/Snap/Internal/Http/Server/Backend.hs
+++ b/src/Snap/Internal/Http/Server/Backend.hs
@@ -42,7 +42,7 @@
     -> Enumerator ByteString IO ()           -- ^ read end of socket
     -> Iteratee ByteString IO ()             -- ^ write end of socket
     -> (FilePath -> Int64 -> Int64 -> IO ()) -- ^ sendfile end
-    -> (Int -> IO ())                        -- ^ timeout tickler
+    -> ((Int -> Int) -> IO ())               -- ^ timeout tickler
     -> IO ()
 
 
diff --git a/src/Snap/Internal/Http/Server/HttpPort.hs b/src/Snap/Internal/Http/Server/HttpPort.hs
--- a/src/Snap/Internal/Http/Server/HttpPort.hs
+++ b/src/Snap/Internal/Http/Server/HttpPort.hs
@@ -1,6 +1,6 @@
+{-# LANGUAGE CPP                      #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings        #-}
 
 module Snap.Internal.Http.Server.HttpPort
   ( bindHttp
@@ -10,68 +10,66 @@
   , send
   ) where
 
-
 ------------------------------------------------------------------------------
 import           Data.ByteString (ByteString)
-#ifdef PORTABLE
-import qualified Data.ByteString as B
-#endif
 import           Foreign
 import           Foreign.C
 import           Network.Socket hiding (recv, send)
 import           Unsafe.Coerce
-
+------------------------------------------------------------------------------
 #ifdef PORTABLE
+import qualified Data.ByteString as B
 import qualified Network.Socket.ByteString as SB
 #else
 import qualified Data.ByteString.Internal as BI
 import qualified Data.ByteString.Unsafe as BI
 #endif
-
+------------------------------------------------------------------------------
 import           Snap.Internal.Debug
 import           Snap.Internal.Http.Server.Backend
 import           Snap.Internal.Http.Server.Address
 
+
 ------------------------------------------------------------------------------
 bindHttp :: ByteString -> Int -> IO ListenSocket
 bindHttp bindAddr bindPort = do
     (family, addr) <- getSockAddr bindPort bindAddr
-    sock <- socket family Stream 0
+    sock           <- socket family Stream 0
+
     debug $ "bindHttp: binding port " ++ show addr
     setSocketOption sock ReuseAddr 1
     bindSocket sock addr
     listen sock 150
+
     debug $ "bindHttp: bound socket " ++ show sock
-    return $ ListenHttp sock
+    return $! ListenHttp sock
 
 
 ------------------------------------------------------------------------------
 createSession :: Int -> CInt -> IO () -> IO NetworkSession
 createSession buffSize s _ =
-    return $ NetworkSession s (unsafeCoerce ()) $ fromIntegral buffSize
+    return $! NetworkSession s (unsafeCoerce ()) $ fromIntegral buffSize
 
 
 ------------------------------------------------------------------------------
 endSession :: NetworkSession -> IO ()
 endSession _ = return ()
 
-#ifdef PORTABLE
 
+#ifdef PORTABLE
 ------------------------------------------------------------------------------
 recv :: Socket -> IO () -> NetworkSession -> IO (Maybe ByteString)
 recv sock _ (NetworkSession { _recvLen = s }) = do
     bs <- SB.recv sock (fromIntegral s)
-    if B.null bs
-        then return Nothing
-        else return $ Just bs
+    return $! if B.null bs then Nothing else Just bs
 
 
 ------------------------------------------------------------------------------
 send :: Socket -> IO () -> IO () -> NetworkSession -> ByteString -> IO ()
 send sock tickle _ _ bs = SB.sendAll sock bs >> tickle
 
-#else
 
+#else
 ------------------------------------------------------------------------------
 recv :: IO () -> NetworkSession -> IO (Maybe ByteString)
 recv onBlock (NetworkSession s _ buffSize) = do
@@ -84,23 +82,25 @@
 
     if sz == 0
       then return Nothing
-      else return $ Just $ BI.fromForeignPtr fp 0 $ fromEnum sz
+      else return $! Just $! BI.fromForeignPtr fp 0 $! fromEnum sz
 
 
 ------------------------------------------------------------------------------
 send :: IO () -> IO () -> NetworkSession -> ByteString -> IO ()
 send tickleTimeout onBlock (NetworkSession s _ _) bs =
     BI.unsafeUseAsCStringLen bs $ uncurry loop
-  where loop ptr len = do
-          sent <- throwErrnoIfMinus1RetryMayBlock
-                    "send"
-                    (c_write s ptr $ toEnum len)
-                    onBlock
 
-          let sent' = fromIntegral sent
-          if sent' < len
-             then tickleTimeout >> loop (plusPtr ptr sent') (len - sent')
-             else tickleTimeout
+  where
+    loop ptr len = do
+        sent <- throwErrnoIfMinus1RetryMayBlock
+                  "send"
+                  (c_write s ptr $ toEnum len)
+                  onBlock
+
+        let sent' = fromIntegral sent
+        if sent' < len
+           then tickleTimeout >> loop (plusPtr ptr sent') (len - sent')
+           else tickleTimeout
 
 
 ------------------------------------------------------------------------------
diff --git a/src/Snap/Internal/Http/Server/LibevBackend.hs b/src/Snap/Internal/Http/Server/LibevBackend.hs
--- a/src/Snap/Internal/Http/Server/LibevBackend.hs
+++ b/src/Snap/Internal/Http/Server/LibevBackend.hs
@@ -238,7 +238,7 @@
   where
     go = runSession defaultTimeout back handler sock
     cleanup = [ Handler $ \(_ :: TimeoutException) -> return ()
-              , Handler $ \(e :: AsyncException)   -> return ()
+              , Handler $ \(_ :: AsyncException)   -> return ()
               , Handler $ \(e :: SomeException) ->
                   elog $ S.concat [ "libev.acceptCallback: "
                                   , S.pack . map c2w $ show e ]
@@ -570,24 +570,45 @@
 
 
 ------------------------------------------------------------------------------
-tickleTimeout :: Connection -> Int -> IO ()
-tickleTimeout conn tm = do
-    debug "Libev.tickleTimeout"
-    now  <- getCurrentDateTime
-    prev <- readIORef ref
-    let !n = max (now + toEnum tm) prev
-    writeIORef ref n
+modifyTimeout :: Connection -> (Int -> Int) -> IO ()
+modifyTimeout conn f = do
+    debug "Libev.modifyTimeout"
+    !prev <- readIORef tt
+    !now  <- getCurrentDateTime
 
+    let !remaining    = fromEnum $ max 0 (prev - now)
+    let !newRemaining = f remaining
+    let !newTimeout   = now + toEnum newRemaining
+
+    writeIORef tt $! now + toEnum newRemaining
+
+    -- Here the question is: do we reset the ev timer? If we're extending the
+    -- timeout, the ev manual suggests it's more efficient to let the timer
+    -- lapse and re-arm. If we're shortening the timeout, we need to update the
+    -- timer so it fires when it's supposed to.
+    when (newTimeout < prev) $ withMVar loopLock $ \_ -> do
+        evTimerSetRepeat tmr $! toEnum newRemaining
+        evTimerAgain loop tmr
+        -- wake up the event loop so it can be apprised of the changes
+        evAsyncSend loop asyncObj
+
   where
-    ref = _timerTimeoutTime conn
+    tt       = _timerTimeoutTime conn
+    backend  = _backend conn
+    asyncObj = _asyncObj backend
+    loopLock = _loopLock backend
+    loop     = _evLoop backend
+    tmr      = _timerObj conn
 
 
 ------------------------------------------------------------------------------
+tickleTimeout :: Connection -> Int -> IO ()
+tickleTimeout conn = modifyTimeout conn . max
+
+
+------------------------------------------------------------------------------
 setTimeout :: Connection -> Int -> IO ()
-setTimeout conn tm = do
-    debug "Libev.tickleTimeout"
-    now       <- getCurrentDateTime
-    writeIORef (_timerTimeoutTime conn) (now + toEnum tm)
+setTimeout conn = modifyTimeout conn . const
 
 
 ------------------------------------------------------------------------------
diff --git a/src/Snap/Internal/Http/Server/ListenHelpers.hs b/src/Snap/Internal/Http/Server/ListenHelpers.hs
--- a/src/Snap/Internal/Http/Server/ListenHelpers.hs
+++ b/src/Snap/Internal/Http/Server/ListenHelpers.hs
@@ -14,13 +14,13 @@
 
 ------------------------------------------------------------------------------
 listenSocket :: ListenSocket -> Socket
-listenSocket (ListenHttp s) = s
+listenSocket (ListenHttp  s  ) = s
 listenSocket (ListenHttps s _) = s
 
 
 ------------------------------------------------------------------------------
 isSecure :: ListenSocket -> Bool
-isSecure (ListenHttp _)      = False
+isSecure (ListenHttp  _  ) = False
 isSecure (ListenHttps _ _) = True
 
 
@@ -31,52 +31,48 @@
 
 ------------------------------------------------------------------------------
 createSession :: ListenSocket -> Int -> CInt -> IO () -> IO NetworkSession
-createSession (ListenHttp _)        = Http.createSession
-createSession p@(ListenHttps _ _)   = TLS.createSession p
+createSession (ListenHttp    _  ) = Http.createSession
+createSession p@(ListenHttps _ _) = TLS.createSession p
 
 
 ------------------------------------------------------------------------------
 endSession :: ListenSocket -> NetworkSession -> IO ()
-endSession (ListenHttp _)      = Http.endSession
-endSession (ListenHttps _ _)   = TLS.endSession
+endSession (ListenHttp  _  ) = Http.endSession
+endSession (ListenHttps _ _) = TLS.endSession
 
 
 #ifdef PORTABLE
-
-
 -- For portable builds, we can't call read/write directly so we need the
 -- original haskell socket to use with network-bytestring package.
 -- Only the simple backend creates sockets in haskell so the following
 -- functions only work with the simple backend.
 
-
 ------------------------------------------------------------------------------
 recv :: ListenSocket -> Socket -> IO () -> NetworkSession
      -> IO (Maybe ByteString)
-recv (ListenHttp _)      s = Http.recv s
-recv (ListenHttps _ _) _   = TLS.recv
+recv (ListenHttp  _  ) s = Http.recv s
+recv (ListenHttps _ _) _ = TLS.recv
 
 
 ------------------------------------------------------------------------------
 send :: ListenSocket -> Socket -> IO () -> IO () -> NetworkSession
      -> ByteString -> IO ()
-send (ListenHttp _)      s = Http.send s
-send (ListenHttps _ _) _   = TLS.send
+send (ListenHttp  _  ) s = Http.send s
+send (ListenHttps _ _) _ = TLS.send
 
 
 #else
 
-
 ------------------------------------------------------------------------------
 recv :: ListenSocket -> IO () -> NetworkSession -> IO (Maybe ByteString)
-recv (ListenHttp _)      = Http.recv
-recv (ListenHttps _ _)   = TLS.recv
+recv (ListenHttp  _  ) = Http.recv
+recv (ListenHttps _ _) = TLS.recv
 
 
 ------------------------------------------------------------------------------
 send :: ListenSocket -> IO () -> IO () -> NetworkSession -> ByteString
      -> IO ()
-send (ListenHttp _)      = Http.send
-send (ListenHttps _ _)   = TLS.send
+send (ListenHttp  _  ) = Http.send
+send (ListenHttps _ _) = TLS.send
 
 #endif
diff --git a/src/Snap/Internal/Http/Server/SimpleBackend.hs b/src/Snap/Internal/Http/Server/SimpleBackend.hs
--- a/src/Snap/Internal/Http/Server/SimpleBackend.hs
+++ b/src/Snap/Internal/Http/Server/SimpleBackend.hs
@@ -85,7 +85,7 @@
     accThreads <- forM sockets $ \p -> forkOnIO cpu $
                   acceptThread defaultTimeout handler tmgr elog cpu p exit
 
-    return $ EventLoopCpu cpu accThreads tmgr exit
+    return $! EventLoopCpu cpu accThreads tmgr exit
 
 
 ------------------------------------------------------------------------------
@@ -110,6 +110,7 @@
     acceptAndFork = do
         debug $ "acceptThread: calling accept() on socket " ++ show sock
         (s,addr) <- accept $ Listen.listenSocket sock
+        setSocketOption s NoDelay 1
         debug $ "acceptThread: accepted connection from remote: " ++ show addr
         _ <- forkOnIO cpu (go s addr `catches` cleanup)
         return ()
@@ -120,7 +121,7 @@
 
     go = runSession defaultTimeout handler tmgr sock
 
-    acceptHandler = 
+    acceptHandler =
         [ Handler $ \(e :: AsyncException) -> throwIO e
         , Handler $ \(e :: SomeException) -> do
               elog $ S.concat [ "SimpleBackend.acceptThread: accept threw: "
@@ -160,8 +161,8 @@
     let sinfo = SessionInfo lhost lport rhost rport $ Listen.isSecure lsock
 
     timeoutHandle <- TM.register (killThread curId) tmgr
-    let setTimeout = TM.set timeoutHandle
-    let tickleTimeout = TM.tickle timeoutHandle
+    let modifyTimeout = TM.modify timeoutHandle
+    let tickleTimeout = modifyTimeout . max
 
     bracket (Listen.createSession lsock 8192 fd
               (threadWaitRead $ fromIntegral fd))
@@ -182,7 +183,7 @@
                               writeEnd
                               (sendFile lsock (tickleTimeout defaultTimeout)
                                         fd writeEnd)
-                              setTimeout
+                              modifyTimeout
             )
 
 
diff --git a/src/Snap/Internal/Http/Server/TLS.hs b/src/Snap/Internal/Http/Server/TLS.hs
--- a/src/Snap/Internal/Http/Server/TLS.hs
+++ b/src/Snap/Internal/Http/Server/TLS.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE BangPatterns               #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE EmptyDataDecls             #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
+------------------------------------------------------------------------------
 module Snap.Internal.Http.Server.TLS
   ( TLSException
   , initTLS
@@ -17,15 +17,12 @@
   , send
   ) where
 
-
 ------------------------------------------------------------------------------
 import           Control.Exception
 import           Data.ByteString.Char8 (ByteString)
 import           Data.Dynamic
 import           Foreign.C
-
-import           Snap.Internal.Http.Server.Backend
-
+------------------------------------------------------------------------------
 #ifdef OPENSSL
 import           Control.Monad
 import qualified Data.ByteString.Char8 as S
@@ -40,51 +37,73 @@
 import           OpenSSL
 import           OpenSSL.Session
 import qualified OpenSSL.Session as SSL
+import           Prelude hiding (catch)
 import           Unsafe.Coerce
-
 import           Snap.Internal.Http.Server.Address
 #endif
+------------------------------------------------------------------------------
+import           Snap.Internal.Http.Server.Backend
 
 
+------------------------------------------------------------------------------
 data TLSException = TLSException String
-    deriving (Show, Typeable)
+  deriving (Show, Typeable)
 instance Exception TLSException
 
-#ifndef OPENSSL
 
+#ifndef OPENSSL
+------------------------------------------------------------------------------
 initTLS :: IO ()
 initTLS = throwIO $ TLSException "TLS is not supported"
 
+
+------------------------------------------------------------------------------
 stopTLS :: IO ()
 stopTLS = return ()
 
+
+------------------------------------------------------------------------------
 bindHttps :: ByteString -> Int -> FilePath -> FilePath -> IO ListenSocket
 bindHttps _ _ _ _ = throwIO $ TLSException "TLS is not supported"
 
+
+------------------------------------------------------------------------------
 freePort :: ListenSocket -> IO ()
 freePort _ = return ()
 
+
+------------------------------------------------------------------------------
 createSession :: ListenSocket -> Int -> CInt -> IO () -> IO NetworkSession
 createSession _ _ _ _ = throwIO $ TLSException "TLS is not supported"
 
+
+------------------------------------------------------------------------------
 endSession :: NetworkSession -> IO ()
 endSession _ = return ()
 
+
+------------------------------------------------------------------------------
 send :: IO () -> IO () -> NetworkSession -> ByteString -> IO ()
 send _ _ _ _ = return ()
 
+
+------------------------------------------------------------------------------
 recv :: IO b -> NetworkSession -> IO (Maybe ByteString)
 recv _ _ = throwIO $ TLSException "TLS is not supported"
 
-------------------------------------------------------------------------------
-#else
 
+#else
+------------------------------------------------------------------------------
 initTLS :: IO ()
 initTLS = withOpenSSL $ return ()
 
+
+------------------------------------------------------------------------------
 stopTLS :: IO ()
 stopTLS = return ()
 
+
+------------------------------------------------------------------------------
 bindHttps :: ByteString
           -> Int
           -> FilePath
@@ -92,44 +111,50 @@
           -> IO ListenSocket
 bindHttps bindAddress bindPort cert key = do
     (family, addr) <- getSockAddr bindPort bindAddress
-    sock <- Socket.socket family Socket.Stream 0
+    sock           <- Socket.socket family Socket.Stream 0
+
     Socket.setSocketOption sock Socket.ReuseAddr 1
     Socket.bindSocket sock addr
     Socket.listen sock 150
 
     ctx <- context
-    contextSetPrivateKeyFile ctx key
+    contextSetPrivateKeyFile  ctx key
     contextSetCertificateFile ctx cert
-    contextSetDefaultCiphers ctx
+    contextSetDefaultCiphers  ctx
+
     certOK <- contextCheckPrivateKey ctx
-    when (not certOK) $ do
-        throwIO $ TLSException $ "OpenSSL says that the certificate "
-                ++ "doesn't match the private key!"
+    when (not certOK) $ throwIO $ TLSException certificateError
+    return $! ListenHttps sock ctx
 
-    return $ ListenHttps sock ctx
+  where
+    certificateError = "OpenSSL says that the certificate " ++
+                       "doesn't match the private key!"
 
 
+------------------------------------------------------------------------------
 freePort :: ListenSocket -> IO ()
 freePort (ListenHttps sock _) = Socket.sClose sock
 freePort _ = return ()
 
 
+------------------------------------------------------------------------------
 createSession :: ListenSocket -> Int -> CInt -> IO () -> IO NetworkSession
 createSession (ListenHttps _ ctx) recvSize socket _ = do
     csock <- mkSocket socket AF_INET Stream defaultProtocol Connected
-    ssl   <- connection ctx csock
-
-    accept ssl
-    return $ NetworkSession socket (unsafeCoerce ssl) recvSize
+    handle (\(e::SomeException) -> Socket.sClose csock >> throwIO e) $ do
+        ssl <- connection ctx csock
+        accept ssl
+        return $! NetworkSession socket (unsafeCoerce ssl) recvSize
 createSession _ _ _ _ = error "can't call createSession on a ListenHttp"
 
 
+------------------------------------------------------------------------------
 endSession :: NetworkSession -> IO ()
-endSession (NetworkSession _ aSSL _) = shutdown ssl Bidirectional
-  where
-    ssl = unsafeCoerce aSSL
+endSession (NetworkSession _ aSSL _) =
+    shutdown (unsafeCoerce aSSL) Unidirectional
 
 
+------------------------------------------------------------------------------
 send :: IO () -> IO () -> NetworkSession -> ByteString -> IO ()
 send tickleTimeout _ (NetworkSession _ aSSL sz) bs = go bs
   where
@@ -141,20 +166,19 @@
     go !s = if S.null s
               then return ()
               else do
-                  SSL.write ssl a
-                  tickleTimeout
-                  go b
-
+                SSL.write ssl a
+                tickleTimeout
+                go b
       where
         (a,b) = S.splitAt sz s
 
 
+------------------------------------------------------------------------------
 recv :: IO b -> NetworkSession -> IO (Maybe ByteString)
 recv _ (NetworkSession _ aSSL recvLen) = do
     b <- SSL.read ssl recvLen
-    if S.null b then return Nothing else return $ Just b
+    return $! if S.null b then Nothing else Just b
   where
     ssl = unsafeCoerce aSSL
-
 
 #endif
diff --git a/src/Snap/Internal/Http/Server/TimeoutManager.hs b/src/Snap/Internal/Http/Server/TimeoutManager.hs
--- a/src/Snap/Internal/Http/Server/TimeoutManager.hs
+++ b/src/Snap/Internal/Http/Server/TimeoutManager.hs
@@ -8,6 +8,7 @@
   , register
   , tickle
   , set
+  , modify
   , cancel
   ) where
 
@@ -21,8 +22,10 @@
 ------------------------------------------------------------------------------
 data State = Deadline !CTime
            | Canceled
-  deriving (Eq)
+  deriving (Eq, Show)
 
+
+------------------------------------------------------------------------------
 instance Ord State where
     compare Canceled Canceled         = EQ
     compare Canceled _                = LT
@@ -31,6 +34,43 @@
 
 
 ------------------------------------------------------------------------------
+-- Probably breaks Num laws, but I can live with it
+--
+instance Num State where
+    --------------------------------------------------------------------------
+    Canceled     + Canceled     = Canceled
+    Canceled     + x            = x
+    x            + Canceled     = x
+    (Deadline a) + (Deadline b) = Deadline $! a + b
+
+    --------------------------------------------------------------------------
+    Canceled     - Canceled     = Canceled
+    Canceled     - x            = negate x
+    x            - Canceled     = x
+    (Deadline a) - (Deadline b) = Deadline $! a - b
+
+    --------------------------------------------------------------------------
+    Canceled     * _            = Canceled
+    _            * Canceled     = Canceled
+    (Deadline a) * (Deadline b) = Deadline $! a * b
+
+    --------------------------------------------------------------------------
+    negate Canceled     = Canceled
+    negate (Deadline d) = Deadline (negate d)
+
+    --------------------------------------------------------------------------
+    abs Canceled     = Canceled
+    abs (Deadline d) = Deadline (abs d)
+
+    --------------------------------------------------------------------------
+    signum Canceled     = Canceled
+    signum (Deadline d) = Deadline (signum d)
+
+    --------------------------------------------------------------------------
+    fromInteger = Deadline . fromInteger
+
+
+------------------------------------------------------------------------------
 data TimeoutHandle = TimeoutHandle {
       _killAction :: !(IO ())
     , _state      :: !(IORef State)
@@ -39,6 +79,20 @@
 
 
 ------------------------------------------------------------------------------
+-- | Given a 'State' value and the current time, apply the given modification
+-- function to the amount of time remaining.
+--
+smap :: CTime -> (Int -> Int) -> State -> State
+smap _ _ Canceled       = Canceled
+
+smap now f (Deadline t) = Deadline t'
+  where
+    !remaining    = fromEnum $ max 0 (t - now)
+    !newremaining = f remaining
+    !t'           = now + toEnum newremaining
+
+
+------------------------------------------------------------------------------
 data TimeoutManager = TimeoutManager {
       _defaultTimeout :: !Int
     , _getTime        :: !(IO CTime)
@@ -108,38 +162,37 @@
 -- future. If the existing timeout is set for M seconds from now, where M > N,
 -- then the timeout is unaffected.
 tickle :: TimeoutHandle -> Int -> IO ()
-tickle th n = do
-    now <- getTime
-
-    -- don't need atomicity here -- kill the space leak.
-    orig <- readIORef stateRef
-    let state = Deadline $ now + toEnum n
-    let !newState = max orig state
-    writeIORef stateRef newState
-
-  where
-    getTime  = _hGetTime th
-    stateRef = _state th
+tickle th = modify th . max
+{-# INLINE tickle #-}
 
 
 ------------------------------------------------------------------------------
 -- | Set the timeout on a connection to be N seconds into the future.
 set :: TimeoutHandle -> Int -> IO ()
-set th n = do
-    now <- getTime
+set th = modify th . const
+{-# INLINE set #-}
 
-    let state = Deadline $ now + toEnum n
-    writeIORef stateRef state
 
+------------------------------------------------------------------------------
+-- | Modify the timeout with the given function.
+modify :: TimeoutHandle -> (Int -> Int) -> IO ()
+modify th f = do
+    now   <- getTime
+    state <- readIORef stateRef
+    let !state' = smap now f state
+    writeIORef stateRef state'
+
   where
     getTime  = _hGetTime th
     stateRef = _state th
+{-# INLINE modify #-}
 
 
 ------------------------------------------------------------------------------
 -- | Cancel a timeout.
 cancel :: TimeoutHandle -> IO ()
 cancel h = writeIORef (_state h) Canceled
+{-# INLINE cancel #-}
 
 
 ------------------------------------------------------------------------------
diff --git a/test/common/Snap/Test/Common.hs b/test/common/Snap/Test/Common.hs
--- a/test/common/Snap/Test/Common.hs
+++ b/test/common/Snap/Test/Common.hs
@@ -18,6 +18,7 @@
 import           Network.Socket
 import qualified Network.Socket.ByteString as N
 import           Prelude hiding (catch)
+import           Test.HUnit (assertFailure)
 import           Test.QuickCheck
 import           System.Timeout
 
@@ -31,10 +32,18 @@
     arbitrary = do
         n      <- choose(0,5)
         chunks <- replicateM n arbitrary
-        return $ L.fromChunks chunks
+        return $! L.fromChunks chunks
 
 
 
+expectException :: IO a -> IO ()
+expectException m = do
+    e <- try m
+    case e of
+      Left (_::SomeException)  -> return ()
+      Right _ -> assertFailure "expected exception, didn't get it"
+
+
 expectExceptionBeforeTimeout :: IO a    -- ^ action to run
                              -> Int     -- ^ number of seconds to expect
                                         -- exception by
@@ -71,7 +80,7 @@
 recvAll :: Socket -> IO ByteString
 recvAll sock = do
     b <- f mempty sock
-    return $ toByteString b
+    return $! toByteString b
 
   where
     f b sk = do
diff --git a/test/common/Test/Common/TestHandler.hs b/test/common/Test/Common/TestHandler.hs
--- a/test/common/Test/Common/TestHandler.hs
+++ b/test/common/Test/Common/TestHandler.hs
@@ -13,6 +13,7 @@
 import qualified Data.Map as Map
 import           Data.Maybe
 import           Data.Monoid
+import           Snap.Internal.Debug
 import           Snap.Iteratee hiding (Enumerator)
 import qualified Snap.Iteratee as I
 import           Snap.Core
@@ -31,29 +32,43 @@
 timeoutTickleHandler = do
     noCompression   -- FIXME: remove this when zlib-bindings and
                     -- zlib-enumerator support gzip stream flushing
-    modifyResponse $ setResponseBody (trickleOutput 6)
+    modifyResponse $ setResponseBody (trickleOutput 10)
                    . setContentType "text/plain"
+                   . setBufferingMode False
     setTimeout 2
 
+
+badTimeoutTickleHandler :: Snap ()
+badTimeoutTickleHandler = do
+    noCompression   -- FIXME: remove this when zlib-bindings and
+                    -- zlib-enumerator support gzip stream flushing
+    modifyResponse $ setResponseBody (trickleOutput 10)
+                   . setContentType "text/plain"
+    setTimeout 2
+
+
+trickleOutput :: Int -> Enumerator Builder IO a
+trickleOutput n = concatEnums $ dots `interleave` delays
   where
-    trickleOutput :: Int -> Enumerator Builder IO a
-    trickleOutput n = concatEnums $ dots `interleave` delays
-      where
-        enumOne = enumList 1 [fromByteString ".\n", flush]
-        delay st = do
-            liftIO $ threadDelay 1000000
-            returnI st
+    enumOne i = do
+        debug "enumOne: .\\n"
+        enumList 1 [fromByteString ".\n"] i
 
-        interleave x0 y0 = (go id x0 y0) []
-          where
-            go !dl [] ys = dl . (++ys)
-            go !dl xs [] = dl . (++xs)
-            go !dl (x:xs) (y:ys) = go (dl . (x:) . (y:)) xs ys
+    delay st = do
+        debug "delay 1s"
+        liftIO $ threadDelay 1000000
+        returnI st
 
-        dots   = replicate n enumOne
-        delays = replicate n delay
+    interleave x0 y0 = (go id x0 y0) []
+      where
+        go !dl [] ys = dl . (++ys)
+        go !dl xs [] = dl . (++xs)
+        go !dl (x:xs) (y:ys) = go (dl . (x:) . (y:)) xs ys
 
+    dots   = replicate n enumOne
+    delays = replicate n delay
 
+
 ------------------------------------------------------------------------------
 pongHandler :: Snap ()
 pongHandler = modifyResponse $
@@ -148,8 +163,8 @@
 
         modifyResponse $ setContentType "text/plain"
         writeBuilder $ buildRqParams params `mappend` buildFiles m
-        
 
+
     builder _ [] = mempty
     builder ty ((k,v):xs) =
         mconcat [ fromByteString ty
@@ -172,14 +187,15 @@
 
 testHandler :: Snap ()
 testHandler = withCompression $
-    route [ ("pong"           , pongHandler                       )
-          , ("echo"           , echoHandler                       )
-          , ("rot13"          , rot13Handler                      )
-          , ("echoUri"        , echoUriHandler                    )
-          , ("fileserve"      , serveDirectory "testserver/static")
-          , ("bigresponse"    , bigResponseHandler                )
-          , ("respcode/:code" , responseHandler                   )
-          , ("upload/form"    , uploadForm                        )
-          , ("upload/handle"  , uploadHandler                     )
-          , ("timeout/tickle" , timeoutTickleHandler              )
+    route [ ("pong"              , pongHandler                       )
+          , ("echo"              , echoHandler                       )
+          , ("rot13"             , rot13Handler                      )
+          , ("echoUri"           , echoUriHandler                    )
+          , ("fileserve"         , serveDirectory "testserver/static")
+          , ("bigresponse"       , bigResponseHandler                )
+          , ("respcode/:code"    , responseHandler                   )
+          , ("upload/form"       , uploadForm                        )
+          , ("upload/handle"     , uploadHandler                     )
+          , ("timeout/tickle"    , timeoutTickleHandler              )
+          , ("timeout/badtickle" , badTimeoutTickleHandler           )
           ]
diff --git a/test/snap-server-testsuite.cabal b/test/snap-server-testsuite.cabal
--- a/test/snap-server-testsuite.cabal
+++ b/test/snap-server-testsuite.cabal
@@ -21,42 +21,42 @@
   main-is:         TestSuite.hs
 
   build-depends:
-    QuickCheck >= 2,
-    array >= 0.3 && <0.4,
-    attoparsec >= 0.10 && < 0.11,
-    attoparsec-enumerator >= 0.3 && < 0.4,
-    base >= 4 && < 5,
-    base16-bytestring == 0.1.*,
-    binary >= 0.5 && < 0.6,
-    blaze-builder >= 0.2.1.4 && <0.4,
-    blaze-builder-enumerator >= 0.2.0 && <0.3,
+    QuickCheck                 >= 2,
+    array                      >= 0.3     && <0.5,
+    attoparsec                 >= 0.10    && <0.11,
+    attoparsec-enumerator      >= 0.3     && <0.4,
+    base                       >= 4       && <5,
+    base16-bytestring          == 0.1.*,
+    binary                     >= 0.5     && <0.6,
+    blaze-builder              >= 0.2.1.4 && <0.4,
+    blaze-builder-enumerator   >= 0.2.0   && <0.3,
     bytestring,
-    bytestring-nums >= 0.3.1 && < 0.4,
+    bytestring-nums            >= 0.3.1   && <0.4,
     containers,
     directory,
     directory-tree,
-    enumerator >= 0.4.13.1 && <0.5,
+    enumerator                 >= 0.4.15  && <0.5,
     filepath,
-    http-enumerator >= 0.7.1.6 && <0.8,
-    HUnit >= 1.2 && < 2,
-    mtl >= 2 && <3,
-    murmur-hash >= 0.1 && < 0.2,
-    network == 2.3.*,
+    http-enumerator            >= 0.7.1.6 && <0.8,
+    HUnit                      >= 1.2     && <2,
+    mtl                        >= 2       && <3,
+    murmur-hash                >= 0.1     && <0.2,
+    network                    == 2.3.*,
     old-locale,
-    parallel > 2,
+    parallel                   >= 2       && <4,
     process,
-    snap-core >= 0.7 && < 0.8,
+    snap-core                  >= 0.8     && <0.9,
     template-haskell,
-    test-framework >= 0.4 && < 0.5,
-    test-framework-hunit >= 0.2.5 && < 0.3,
-    test-framework-quickcheck2 >= 0.2.6 && < 0.3,
-    text >= 0.11 && <0.12,
+    test-framework             >= 0.4     && <0.6,
+    test-framework-hunit       >= 0.2.5   && <0.3,
+    test-framework-quickcheck2 >= 0.2.6   && <0.3,
+    text                       >= 0.11    && <0.12,
     time,
-    tls >= 0.8.2 && <0.9,
+    tls                        >= 0.8.2   && <0.10,
     transformers,
-    vector >= 0.7 && <0.10,
-    vector-algorithms >= 0.4 && <0.6,
-    PSQueue >= 1.1 && <1.2
+    vector                     >= 0.7     && <0.10,
+    vector-algorithms          >= 0.4     && <0.6,
+    PSQueue                    >= 1.1     && <1.2
 
   extensions:
     BangPatterns,
@@ -97,37 +97,37 @@
   main-is:         Main.hs
 
   build-depends:
-    QuickCheck >= 2,
-    array >= 0.3 && <0.4,
-    attoparsec >= 0.10 && < 0.11,
-    attoparsec-enumerator >= 0.3 && < 0.4,
-    base >= 4 && < 5,
-    base16-bytestring == 0.1.*,
-    blaze-builder >= 0.2.1.4 && <0.4,
-    blaze-builder-enumerator >= 0.2.0 && <0.3,
+    QuickCheck                >= 2,
+    array                     >= 0.3     && <0.5,
+    attoparsec                >= 0.10    && <0.11,
+    attoparsec-enumerator     >= 0.3     && <0.4,
+    base                      >= 4       && <5,
+    base16-bytestring         == 0.1.*,
+    blaze-builder             >= 0.2.1.4 && <0.4,
+    blaze-builder-enumerator  >= 0.2.0   && <0.3,
     bytestring,
-    bytestring-nums >= 0.3.1 && < 0.4,
-    cereal >= 0.3 && < 0.4,
+    bytestring-nums           >= 0.3.1   && <0.4,
+    cereal                    >= 0.3     && <0.4,
     containers,
     directory-tree,
-    enumerator >= 0.4.7 && <0.5,
+    enumerator                >= 0.4.15  && <0.5,
     filepath,
-    HUnit >= 1.2 && < 2,
-    mtl >= 2 && <3,
-    murmur-hash >= 0.1 && < 0.2,
+    HUnit                     >= 1.2     && <2,
+    mtl                       >= 2       && <3,
+    murmur-hash               >= 0.1     && <0.2,
     old-locale,
-    parallel > 2,
-    MonadCatchIO-transformers >= 0.2.1 && < 0.3,
-    network == 2.3.*,
-    snap-core >= 0.7 && < 0.8,
+    parallel                  >= 2       && <4,
+    MonadCatchIO-transformers >= 0.2.1   && <0.3,
+    network                   == 2.3.*,
+    snap-core                 >= 0.8     && <0.9,
     template-haskell,
     time,
     transformers,
-    unix-compat >= 0.2 && <0.4,
-    utf8-string >= 0.3.6 && <0.4,
-    vector >= 0.7 && <0.10,
-    vector-algorithms >= 0.4 && <0.6,
-    PSQueue >= 1.1 && <1.2
+    unix-compat               >= 0.2     && <0.4,
+    utf8-string               >= 0.3.6   && <0.4,
+    vector                    >= 0.7     && <0.10,
+    vector-algorithms         >= 0.4     && <0.6,
+    PSQueue                   >= 1.1     && <1.2
 
   if flag(portable) || os(windows)
     cpp-options: -DPORTABLE
@@ -173,38 +173,38 @@
   main-is:         Main.hs
 
   build-depends:
-    QuickCheck >= 2,
-    array >= 0.3 && <0.4,
-    attoparsec >= 0.10 && < 0.11,
-    attoparsec-enumerator >= 0.3 && < 0.4,
-    base >= 4 && < 5,
-    binary >= 0.5 && < 0.6,
-    blaze-builder >= 0.2.1.4 && <0.4,
-    blaze-builder-enumerator >= 0.2.0 && <0.3,
+    QuickCheck                 >= 2,
+    array                      >= 0.3     && <0.5,
+    attoparsec                 >= 0.10    && <0.11,
+    attoparsec-enumerator      >= 0.3     && <0.4,
+    base                       >= 4       && <5,
+    binary                     >= 0.5     && <0.6,
+    blaze-builder              >= 0.2.1.4 && <0.4,
+    blaze-builder-enumerator   >= 0.2.0   && <0.3,
     bytestring,
-    bytestring-nums >= 0.3.1 && < 0.4,
-    case-insensitive >= 0.3 && < 0.5,
+    bytestring-nums            >= 0.3.1   && <0.4,
+    case-insensitive           >= 0.3     && <0.5,
     containers,
     directory-tree,
-    enumerator >= 0.4.7 && <0.5,
+    enumerator                 >= 0.4.15  && <0.5,
     filepath,
-    HUnit >= 1.2 && < 2,
-    MonadCatchIO-transformers >= 0.2.1 && < 0.3,
-    mtl >= 2 && <3,
-    murmur-hash >= 0.1 && < 0.2,
-    network == 2.3.*,
+    HUnit                      >= 1.2     && <2,
+    MonadCatchIO-transformers  >= 0.2.1   && <0.3,
+    mtl                        >= 2       && <3,
+    murmur-hash                >= 0.1     && <0.2,
+    network                    == 2.3.*,
     old-locale,
-    parallel > 2,
-    snap-core >= 0.7 && < 0.8,
+    parallel                   >= 2       && <4,
+    snap-core                  >= 0.8     && <0.9,
     template-haskell,
-    test-framework >= 0.4 && < 0.5,
-    test-framework-hunit >= 0.2.5 && < 0.3,
-    test-framework-quickcheck2 >= 0.2.6 && < 0.3,
-    text >= 0.11 && <0.12,
+    test-framework             >= 0.4     && <0.6,
+    test-framework-hunit       >= 0.2.5   && <0.3,
+    test-framework-quickcheck2 >= 0.2.6   && <0.3,
+    text                       >= 0.11    && <0.12,
     time,
-    vector >= 0.7 && <0.10,
-    vector-algorithms >= 0.4 && <0.6,
-    PSQueue >= 1.1 && <1.2
+    vector                     >= 0.7     && <0.10,
+    vector-algorithms          >= 0.4     && <0.6,
+    PSQueue                    >= 1.1     && <1.2
 
   if !os(windows)
     build-depends: unix
@@ -240,5 +240,5 @@
     base >= 4 && < 5,
     network == 2.3.*,
     http-enumerator >= 0.7.1.6 && <0.8,
-    tls >= 0.8.2 && <0.9,
-    criterion >= 0.5 && <0.6
+    tls >= 0.8.2 && <0.10,
+    criterion >= 0.6 && <0.7
diff --git a/test/suite/Snap/Internal/Http/Server/Tests.hs b/test/suite/Snap/Internal/Http/Server/Tests.hs
--- a/test/suite/Snap/Internal/Http/Server/Tests.hs
+++ b/test/suite/Snap/Internal/Http/Server/Tests.hs
@@ -195,8 +195,8 @@
 
         assertEqual "parse body" "0123456789" body
 
-        assertEqual "cookie" 
-                    [Cookie "foo" "bar\"" Nothing Nothing Nothing False False] 
+        assertEqual "cookie"
+                    [Cookie "foo" "bar\"" Nothing Nothing Nothing False False]
                     (rqCookies req)
 
         assertEqual "continued headers" (Just ["foo bar"]) $
@@ -262,14 +262,7 @@
 sampleShortRequest :: ByteString
 sampleShortRequest = "GET /fo"
 
-expectException :: IO a -> IO ()
-expectException m = do
-    e <- try m
-    case e of
-      Left (_::SomeException)  -> return ()
-      Right _ -> assertFailure "expected exception, didn't get it"
 
-
 testPartialParse :: Test
 testPartialParse = testCase "server/short" $ do
     step <- runIteratee $ liftM fromJust $ rsm $ receiveRequest dummyIter
@@ -394,14 +387,21 @@
              sendResponse req rsp1 buf copyingStream2Stream testOnSendFile >>=
                           return . snd
 
-    assertEqual "http response" (L.concat [
-                      "HTTP/1.0 600 Test\r\n"
-                    , "Content-Length: 10\r\n"
-                    , "Foo: Bar\r\n\r\n"
-                    , "0123456789"
-                    ]) b
+    assertBool "http response" (b == text1 || b == text2)
 
   where
+    text1 = L.concat [ "HTTP/1.0 600 Test\r\n"
+                     , "Content-Length: 10\r\n"
+                     , "Foo: Bar\r\n\r\n"
+                     , "0123456789"
+                     ]
+
+    text2 = L.concat [ "HTTP/1.0 600 Test\r\n"
+                     , "Foo: Bar\r\n"
+                     , "Content-Length: 10\r\n\r\n"
+                     , "0123456789"
+                     ]
+
     rsp1 = updateHeaders (H.insert "Foo" "Bar") $
            setContentLength 10 $
            setResponseStatus 600 "Test" $
@@ -554,16 +554,16 @@
 
         ch Nothing  = False
         ch (Just l) =
-            sort l == [ 
+            sort l == [
                 "ck1=bar; path=/; expires=Sat, 30-Jan-2010 00:00:00 GMT; domain=.foo.com; Secure\r"
               , "ck2=bar; path=/; expires=Sat, 30-Jan-2010 00:00:00 GMT; domain=.foo.com; HttpOnly\r"
               , "ck3=bar\r"
               ]
 
-        
 
+
     rsp1 = setResponseStatus 304 "Test" $ emptyResponse { rspHttpVersion = (1,0) }
-    rsp2 = addResponseCookie cook3 . addResponseCookie cook2 
+    rsp2 = addResponseCookie cook3 . addResponseCookie cook2
          . addResponseCookie cook $ rsp1
 
     utc   = UTCTime (ModifiedJulianDay 55226) 0
@@ -574,7 +574,7 @@
 
 
 echoServer :: (ByteString -> IO ())
-           -> (Int -> IO ())
+           -> ((Int -> Int) -> IO ())
            -> Request
            -> Iteratee ByteString IO (Request,Response)
 echoServer _ _ req = do
diff --git a/test/suite/Test/Blackbox.hs b/test/suite/Test/Blackbox.hs
--- a/test/suite/Test/Blackbox.hs
+++ b/test/suite/Test/Blackbox.hs
@@ -58,6 +58,7 @@
                 , testPartial
                 , testFileUpload
                 , testTimeoutTickle
+                , testTimeoutBadTickle
                 ]
 
 
@@ -414,8 +415,8 @@
     req <- parseURL url `catch` (\(e::SomeException) -> do
                  debug $ "parseURL threw exception: " ++ show e
                  throwIO e)
-    fetchReq $ req { HTTP.requestBody = HTTP.RequestBodyLBS body
-                   , HTTP.method = "POST"
+    fetchReq $ req { HTTP.requestBody    = HTTP.RequestBodyLBS body
+                   , HTTP.method         = "POST"
                    , HTTP.requestHeaders = hdrs }
 
 
@@ -430,5 +431,14 @@
         let uri = (if ssl then "https" else "http")
                   ++ "://127.0.0.1:" ++ show port ++ "/timeout/tickle"
         doc <- liftM (S.concat . L.toChunks) $ fetch uri
-        let expected = S.concat $ replicate 6 ".\n"
+        let expected = S.concat $ replicate 10 ".\n"
         assertEqual "response equal" expected doc
+
+
+------------------------------------------------------------------------------
+testTimeoutBadTickle :: Bool -> Int -> String -> Test
+testTimeoutBadTickle ssl port name =
+    testCase (name ++ "/blackbox/timeout/badtickle") $ do
+        let uri = (if ssl then "https" else "http")
+                  ++ "://127.0.0.1:" ++ show port ++ "/timeout/badtickle"
+        expectException $ fetch uri
