diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,7 @@
+## 3.2.4
+
+* Added `withApplication`, `testWithApplication`, and `openFreePort`
+
 ## 3.2.3
 
 * Using http2 v1.5.x which much improves the performance of HTTP/2.
diff --git a/Network/Wai/Handler/Warp.hs b/Network/Wai/Handler/Warp.hs
--- a/Network/Wai/Handler/Warp.hs
+++ b/Network/Wai/Handler/Warp.hs
@@ -90,6 +90,9 @@
   , pauseTimeout
   , FileInfo(..)
   , getFileInfo
+  , withApplication
+  , testWithApplication
+  , openFreePort
     -- * Version
   , warpVersion
   ) where
@@ -108,7 +111,8 @@
 import Network.Wai.Handler.Warp.Run
 import Network.Wai.Handler.Warp.Settings
 import Network.Wai.Handler.Warp.Timeout
-import Network.Wai.Handler.Warp.Types
+import Network.Wai.Handler.Warp.Types hiding (getFileInfo)
+import Network.Wai.Handler.Warp.WithApplication
 
 -- | Port to listen on. Default value: 3000
 --
@@ -242,7 +246,7 @@
 --
 -- For instance, this code should set up a UNIX signal
 -- handler. The handler should call the first argument,
--- which close the listen socket, at shutdown.
+-- which closes the listen socket, at shutdown.
 --
 -- Default: does not install any code.
 --
diff --git a/Network/Wai/Handler/Warp/Date.hs b/Network/Wai/Handler/Warp/Date.hs
--- a/Network/Wai/Handler/Warp/Date.hs
+++ b/Network/Wai/Handler/Warp/Date.hs
@@ -2,8 +2,6 @@
 
 module Network.Wai.Handler.Warp.Date (
     withDateCache
-  , getDate
-  , DateCache
   , GMTDate
   ) where
 
@@ -25,21 +23,14 @@
 -- | The type of the Date header value.
 type GMTDate = ByteString
 
--- | The type of the cache of the Date header value.
-type DateCache = IO GMTDate
-
 -- | Creating 'DateCache' and executing the action.
-withDateCache :: (DateCache -> IO a) -> IO a
+withDateCache :: (IO GMTDate -> IO a) -> IO a
 withDateCache action = initialize >>= action
 
-initialize :: IO DateCache
+initialize :: IO (IO GMTDate)
 initialize = mkAutoUpdate defaultUpdateSettings {
                             updateAction = formatHTTPDate <$> getCurrentHTTPDate
                           }
-
--- | Getting current 'GMTDate' based on 'DateCache'.
-getDate :: DateCache -> IO GMTDate
-getDate = id
 
 #ifdef WINDOWS
 uToH :: UTCTime -> HTTPDate
diff --git a/Network/Wai/Handler/Warp/FdCache.hs b/Network/Wai/Handler/Warp/FdCache.hs
--- a/Network/Wai/Handler/Warp/FdCache.hs
+++ b/Network/Wai/Handler/Warp/FdCache.hs
@@ -2,47 +2,58 @@
 
 -- | File descriptor cache to avoid locks in kernel.
 
-#ifdef WINDOWS
 module Network.Wai.Handler.Warp.FdCache (
     withFdCache
-  , MutableFdCache
-  , Refresh
-  ) where
-
-type Refresh = IO ()
-type MutableFdCache = ()
-
-withFdCache :: Int -> (Maybe MutableFdCache -> IO a) -> IO a
-withFdCache _ f = f Nothing
-#else
-module Network.Wai.Handler.Warp.FdCache (
-    withFdCache
-  , getFd
-  , getFd'
-  , MutableFdCache
+  , Fd
   , Refresh
+#ifndef WINDOWS
+  , openFile
+  , closeFile
+  , setFileCloseOnExec
+#endif
   ) where
 
+#ifndef WINDOWS
 #if __GLASGOW_HASKELL__ < 709
 import Control.Applicative ((<$>), (<*>))
 #endif
 import Control.Exception (bracket)
-import Data.Hashable (hash)
 import Network.Wai.Handler.Warp.IORef
 import Network.Wai.Handler.Warp.MultiMap
-import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
-import System.Posix.Types (Fd)
 import Control.Reaper
+import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd, FdOption(CloseOnExec), setFdOption)
+#endif
+import System.Posix.Types (Fd)
 
 ----------------------------------------------------------------
 
-data Status = Active | Inactive
-
-newtype MutableStatus = MutableStatus (IORef Status)
+type Hash = Int
 
 -- | An action to activate a Fd cache entry.
 type Refresh = IO ()
 
+getFdNothing :: Hash -> FilePath -> IO (Maybe Fd, Refresh)
+getFdNothing _ _ = return (Nothing, return ())
+
+----------------------------------------------------------------
+
+-- | Creating 'MutableFdCache' and executing the action in the second
+--   argument. The first argument is a cache duration in second.
+withFdCache :: Int -> ((Hash -> FilePath -> IO (Maybe Fd, Refresh)) -> IO a) -> IO a
+#ifdef WINDOWS
+withFdCache _        action = action getFdNothing
+#else
+withFdCache 0        action = action getFdNothing
+withFdCache duration action = bracket (initialize duration)
+                                      terminate
+                                      (\mfc -> action (getFd mfc))
+
+----------------------------------------------------------------
+
+data Status = Active | Inactive
+
+newtype MutableStatus = MutableStatus (IORef Status)
+
 status :: MutableStatus -> IO Status
 status (MutableStatus ref) = readIORef ref
 
@@ -59,15 +70,24 @@
 
 data FdEntry = FdEntry !FilePath !Fd !MutableStatus
 
+openFile :: FilePath -> IO Fd
+openFile path = do
+    fd <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock=False}
+    setFileCloseOnExec fd
+    return fd
+
+closeFile :: Fd -> IO ()
+closeFile = closeFd
+
 newFdEntry :: FilePath -> IO FdEntry
-newFdEntry path = FdEntry path
-              <$> openFd path ReadOnly Nothing defaultFileFlags{nonBlock=True}
-              <*> newActiveStatus
+newFdEntry path = FdEntry path <$> openFile path <*> newActiveStatus
 
+setFileCloseOnExec :: Fd -> IO ()
+setFileCloseOnExec fd = setFdOption fd CloseOnExec True
+
 ----------------------------------------------------------------
 
-type Hash = Int
-type FdCache = MMap Hash FdEntry
+type FdCache = MMap FdEntry
 
 -- | Mutable Fd cacher.
 newtype MutableFdCache = MutableFdCache (Reaper FdCache (Hash, FdEntry))
@@ -78,80 +98,52 @@
 look :: MutableFdCache -> FilePath -> Hash -> IO (Maybe FdEntry)
 look mfc path key = searchWith key check <$> fdCache mfc
   where
-    check (One ent@(FdEntry path' _ _))
-      | path == path' = Just ent
-      | otherwise     = Nothing
-    check (Tom ent@(FdEntry path' _ _) vs)
-      | path == path' = Just ent
-      | otherwise     = check vs
-
-----------------------------------------------------------------
-
--- | Creating 'MutableFdCache' and executing the action in the second
---   argument. The first argument is a cache duration in second.
-withFdCache :: Int -> (Maybe MutableFdCache -> IO a) -> IO a
-withFdCache duration action = bracket (initialize duration)
-                                      terminate
-                                      action
+    check (FdEntry path' _ _) = path == path'
 
 ----------------------------------------------------------------
 
 -- The first argument is a cache duration in second.
-initialize :: Int -> IO (Maybe MutableFdCache)
-initialize 0 = return Nothing
-initialize duration = Just . MutableFdCache <$> mkReaper defaultReaperSettings
-    { reaperAction = clean
-    , reaperDelay = duration
-    , reaperCons = uncurry insert
-    , reaperNull = isEmpty
-    , reaperEmpty = empty
-    }
+initialize :: Int -> IO MutableFdCache
+initialize duration = MutableFdCache <$> mkReaper settings
+  where
+    settings = defaultReaperSettings {
+        reaperAction = clean
+      , reaperDelay = duration
+      , reaperCons = uncurry insert
+      , reaperNull = isEmpty
+      , reaperEmpty = empty
+      }
 
 clean :: FdCache -> IO (FdCache -> FdCache)
 clean old = do
     new <- pruneWith old prune
     return $ merge new
-
-prune :: t -> Some FdEntry -> IO [(t, Some FdEntry)]
-prune k v@(One (FdEntry _ fd mst)) = status mst >>= prune'
   where
-    prune' Active   = inactive mst >> return [(k,v)]
-    prune' Inactive = closeFd fd   >> return []
-prune k (Tom ent@(FdEntry _ fd mst) vs) = status mst >>= prune'
-  where
-    prune' Active = do
-        inactive mst
-        zs <- prune k vs
-        case zs of
-            []        -> return [(k,One ent)]
-            [(_,zvs)] -> return [(k,Tom ent zvs)]
-            _         -> error "prune"
-    prune' Inactive = closeFd fd >> prune k vs
+    prune (FdEntry _ fd mst) = status mst >>= act
+      where
+        act Active   = inactive mst >> return True
+        act Inactive = closeFd fd   >> return False
 
 ----------------------------------------------------------------
 
-terminate :: Maybe MutableFdCache -> IO ()
-terminate Nothing = return ()
-terminate (Just (MutableFdCache reaper)) = do
+terminate :: MutableFdCache -> IO ()
+terminate (MutableFdCache reaper) = do
     !t <- reaperStop reaper
     mapM_ closeIt $ toList t
   where
-    closeIt (_, FdEntry _ fd _) = closeFd fd
+    closeIt (FdEntry _ fd _) = closeFd fd
 
 ----------------------------------------------------------------
 
-getFd :: MutableFdCache -> FilePath -> IO (Fd, Refresh)
-getFd mfc path = getFd' mfc (hash path) path
-
 -- | Getting 'Fd' and 'Refresh' from the mutable Fd cacher.
-getFd' :: MutableFdCache -> Hash -> FilePath -> IO (Fd, Refresh)
-getFd' mfc@(MutableFdCache reaper) h path = look mfc path h >>= get
+getFd :: MutableFdCache -> Hash -> FilePath -> IO (Maybe Fd, Refresh)
+getFd mfc@(MutableFdCache reaper) h path = look mfc path h >>= get
   where
     get Nothing = do
         ent@(FdEntry _ fd mst) <- newFdEntry path
         reaperAdd reaper (h, ent)
-        return (fd, refresh mst)
+        return (Just fd, refresh mst)
     get (Just (FdEntry _ fd mst)) = do
         refresh mst
-        return (fd, refresh mst)
+        return (Just fd, refresh mst)
 #endif
diff --git a/Network/Wai/Handler/Warp/File.hs b/Network/Wai/Handler/Warp/File.hs
--- a/Network/Wai/Handler/Warp/File.hs
+++ b/Network/Wai/Handler/Warp/File.hs
@@ -7,14 +7,19 @@
   , conditionalRequest
   , addContentHeadersForFilePart
   , parseByteRanges
+  , packInteger -- testing
   ) where
 
 import Control.Applicative ((<|>))
+import Control.Monad
 import Data.Array ((!))
-import Data.ByteString (ByteString)
 import qualified Data.ByteString as B hiding (pack)
 import qualified Data.ByteString.Char8 as B (pack, readInteger)
+import Data.ByteString.Internal (ByteString(..), unsafeCreate)
 import Data.Maybe (fromMaybe)
+import Data.Word8 (Word8)
+import Foreign.Ptr (Ptr, plusPtr)
+import Foreign.Storable (poke)
 import Network.HTTP.Date
 import qualified Network.HTTP.Types as H
 import qualified Network.HTTP.Types.Header as H
@@ -27,6 +32,9 @@
 #define MIN_VERSION_http_types(x,y,z) 1
 #endif
 
+-- $setup
+-- >>> import Test.QuickCheck
+
 ----------------------------------------------------------------
 
 data RspFileInfo = WithoutBody H.Status
@@ -40,17 +48,17 @@
                    -> RspFileInfo
 conditionalRequest finfo hs0 reqidx = case condition of
     nobody@(WithoutBody _) -> nobody
-    WithBody s _ off len   -> let hs = (H.hLastModified,date) :
-                                       addContentHeaders hs0 off len size
+    WithBody s _ off len   -> let !hs = (H.hLastModified,date) :
+                                        addContentHeaders hs0 off len size
                               in WithBody s hs off len
   where
-    mtime = I.fileInfoTime finfo
-    size  = I.fileInfoSize finfo
-    date  = I.fileInfoDate finfo
-    mcondition = ifmodified    reqidx size mtime
-             <|> ifunmodified  reqidx size mtime
-             <|> ifrange       reqidx size mtime
-    condition = fromMaybe (unconditional reqidx size) mcondition
+    !mtime = I.fileInfoTime finfo
+    !size  = I.fileInfoSize finfo
+    !date  = I.fileInfoDate finfo
+    !mcondition = ifmodified    reqidx size mtime
+              <|> ifunmodified  reqidx size mtime
+              <|> ifrange       reqidx size mtime
+    !condition = fromMaybe (unconditional reqidx size) mcondition
 
 ----------------------------------------------------------------
 
@@ -70,7 +78,7 @@
     date <- ifModifiedSince reqidx
     return $ if date /= mtime
              then unconditional reqidx size
-             else  WithoutBody H.notModified304
+             else WithoutBody H.notModified304
 
 ifunmodified :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo
 ifunmodified reqidx size mtime = do
@@ -140,16 +148,17 @@
 
 ----------------------------------------------------------------
 
--- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'
--- for the range specified.
-contentRangeHeader :: Integer -> Integer -> Integer -> H.Header
-contentRangeHeader beg end total = (
+contentRange :: H.HeaderName
 #if MIN_VERSION_http_types(0,9,0)
-        H.hContentRange
+contentRange = H.hContentRange
 #else
-        "Content-Range"
+contentRange = "Content-Range"
 #endif
-    , range)
+
+-- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'
+-- for the range specified.
+contentRangeHeader :: Integer -> Integer -> Integer -> H.Header
+contentRangeHeader beg end total = (contentRange, range)
   where
     range = B.pack
       -- building with ShowS
@@ -161,19 +170,40 @@
       ( '/'
       : showInt total "")
 
-addContentHeaders :: H.ResponseHeaders -> Integer -> Integer -> Integer -> H.ResponseHeaders
-addContentHeaders hs off len size = hs''
-  where
-    contentRange = contentRangeHeader off (off + len - 1) size
-    !lengthBS = B.pack $ show len
-    hs' = (H.hContentLength, lengthBS):(
+acceptRange :: H.HeaderName
 #if MIN_VERSION_http_types(0,9,0)
-        H.hAcceptRanges
+acceptRange = H.hAcceptRanges
 #else
-        "Accept-Ranges"
+acceptRange = "Accept-Ranges"
 #endif
-        , "bytes"):hs
-    hs'' = if len == size then hs' else contentRange:hs'
+
+addContentHeaders :: H.ResponseHeaders -> Integer -> Integer -> Integer -> H.ResponseHeaders
+addContentHeaders hs off len size
+  | len == size = hs'
+  | otherwise   = let !ctrng = contentRangeHeader off (off + len - 1) size
+                  in ctrng:hs'
+  where
+    !lengthBS = packInteger len
+    !hs' = (H.hContentLength, lengthBS) : (acceptRange,"bytes") : hs
+
+-- |
+--
+-- prop> packInteger (abs n) == B.pack (show (abs n))
+-- prop> \(Large n) -> let n' = fromIntegral (abs n :: Int) in packInteger n' == B.pack (show n')
+
+packInteger :: Integer -> ByteString
+packInteger 0 = "0"
+packInteger n | n < 0 = error "packInteger"
+packInteger n = unsafeCreate len go0
+  where
+    n' = fromIntegral n + 1 :: Double
+    len = ceiling $ logBase 10 n'
+    go0 p = go n $ p `plusPtr` (len - 1)
+    go :: Integer -> Ptr Word8 -> IO ()
+    go i p = do
+        let (d,r) = i `divMod` 10
+        poke p (48 + fromIntegral r)
+        when (d /= 0) $ go d (p `plusPtr` (-1))
 
 -- |
 --
diff --git a/Network/Wai/Handler/Warp/FileInfoCache.hs b/Network/Wai/Handler/Warp/FileInfoCache.hs
--- a/Network/Wai/Handler/Warp/FileInfoCache.hs
+++ b/Network/Wai/Handler/Warp/FileInfoCache.hs
@@ -11,7 +11,6 @@
 import Control.Monad (void)
 import Control.Reaper
 import Data.ByteString (ByteString)
-import Data.Hashable (hash)
 import Network.HTTP.Date
 import Network.Wai.Handler.Warp.HashMap (HashMap)
 import qualified Network.Wai.Handler.Warp.HashMap as M
@@ -55,16 +54,13 @@
       else
         throwIO (userError "FileInfoCache:getInfo")
 
-getInfo' :: Hash -> FilePath -> IO FileInfo
-getInfo' _ = getInfo
+getInfoNaive :: Hash -> FilePath -> IO FileInfo
+getInfoNaive _ = getInfo
 
 ----------------------------------------------------------------
 
-getAndRegisterInfo :: FileInfoCache -> FilePath -> IO FileInfo
-getAndRegisterInfo reaper path = getAndRegisterInfo' reaper (hash path) path
-
-getAndRegisterInfo' :: FileInfoCache -> Hash -> FilePath -> IO FileInfo
-getAndRegisterInfo' reaper@Reaper{..} h path = do
+getAndRegisterInfo :: FileInfoCache -> Hash -> FilePath -> IO FileInfo
+getAndRegisterInfo reaper@Reaper{..} h path = do
     cache <- reaperRead
     case M.lookup h path cache of
         Just Negative     -> throwIO (userError "FileInfoCache:getAndRegisterInfo")
@@ -89,20 +85,20 @@
 --   and executing the action in the second argument.
 --   The first argument is a cache duration in second.
 withFileInfoCache :: Int
-                  -> ((FilePath -> IO FileInfo) -> (Hash -> FilePath -> IO FileInfo) -> IO a)
+                  -> ((Hash -> FilePath -> IO FileInfo) -> IO a)
                   -> IO a
-withFileInfoCache 0        action = action getInfo getInfo'
+withFileInfoCache 0        action = action getInfoNaive
 withFileInfoCache duration action =
     E.bracket (initialize duration)
               terminate
-              (\r -> action (getAndRegisterInfo r) (getAndRegisterInfo' r))
+              (\r -> action (getAndRegisterInfo r))
 
 initialize :: Hash -> IO FileInfoCache
 initialize duration = mkReaper settings
   where
     settings = defaultReaperSettings {
         reaperAction = override
-      , reaperDelay  = duration * 1000000
+      , reaperDelay  = duration
       , reaperCons   = \(h,k,v) -> M.insert h k v
       , reaperNull   = M.null
       , reaperEmpty  = M.empty
diff --git a/Network/Wai/Handler/Warp/HTTP2.hs b/Network/Wai/Handler/Warp/HTTP2.hs
--- a/Network/Wai/Handler/Warp/HTTP2.hs
+++ b/Network/Wai/Handler/Warp/HTTP2.hs
@@ -22,15 +22,15 @@
 
 ----------------------------------------------------------------
 
-http2 :: Connection -> InternalInfo -> SockAddr -> Transport -> S.Settings -> (BufSize -> IO ByteString) -> Application -> IO ()
-http2 conn ii addr transport settings readN app = do
+http2 :: Connection -> InternalInfo1 -> SockAddr -> Transport -> S.Settings -> (BufSize -> IO ByteString) -> Application -> IO ()
+http2 conn ii1 addr transport settings readN app = do
     checkTLS
     ok <- checkPreface
     when ok $ do
         ctx <- newContext
         -- Workers, worker manager and timer manager
         mgr <- start settings
-        let responder = response ii settings ctx mgr
+        let responder = response settings ctx mgr
             action = worker ctx settings app responder
         setAction mgr action
         -- The number of workers is 3.
@@ -40,12 +40,12 @@
         -- context switches happen.
         replicateM_ 3 $ spawnAction mgr
         -- Receiver
-        let mkreq = mkRequest ii settings addr
+        let mkreq = mkRequest ii1 settings addr
         tid <- forkIO $ frameReceiver ctx mkreq readN
         -- Sender
         -- frameSender is the main thread because it ensures to send
         -- a goway frame.
-        frameSender ctx conn ii settings mgr `E.finally` do
+        frameSender ctx conn settings mgr `E.finally` do
             clearContext ctx
             stop mgr
             killThread tid
diff --git a/Network/Wai/Handler/Warp/HTTP2/HPACK.hs b/Network/Wai/Handler/Warp/HTTP2/HPACK.hs
--- a/Network/Wai/Handler/Warp/HTTP2/HPACK.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/HPACK.hs
@@ -34,10 +34,10 @@
     encodeHeaderBuffer buf siz strategy True encodeDynamicTable hs
   where
     status = B8.pack $ show $ H.statusCode s
-    dc = dateCacher ii
+    getdate = getDate ii
     rspidxhdr = indexResponseHeader hdr0
     defServer = S.settingsServerName settings
-    addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr
+    addServerAndDate = addDate getdate rspidxhdr . addServer defServer rspidxhdr
 
 hpackEncodeHeaderLoop :: Context -> Buffer -> BufSize -> HeaderList
                       -> IO (HeaderList, Int)
diff --git a/Network/Wai/Handler/Warp/HTTP2/Receiver.hs b/Network/Wai/Handler/Warp/HTTP2/Receiver.hs
--- a/Network/Wai/Handler/Warp/HTTP2/Receiver.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/Receiver.hs
@@ -111,8 +111,8 @@
                               E.throwIO $ StreamError ProtocolError streamId
                           writeIORef streamPrecedence $ toPrecedence pri
                           writeIORef streamState HalfClosed
-                          let !req = mkreq vh (return "")
-                          atomically $ writeTQueue inputQ $ Input strm req
+                          let (!req, !ii) = mkreq vh (return "")
+                          atomically $ writeTQueue inputQ $ Input strm req ii
                       Nothing -> E.throwIO $ StreamError ProtocolError streamId
               Open (HasBody hdr pri) -> do
                   resetContinued
@@ -124,8 +124,8 @@
                           writeIORef streamContentLength $ vhCL vh
                           readQ <- newReadBody q
                           bodySource <- mkSource readQ
-                          let !req = mkreq vh (readSource bodySource)
-                          atomically $ writeTQueue inputQ $ Input strm req
+                          let (!req, !ii) = mkreq vh (readSource bodySource)
+                          atomically $ writeTQueue inputQ $ Input strm req ii
                       Nothing -> E.throwIO $ StreamError ProtocolError streamId
               s@(Open Continued{}) -> do
                   setContinued
@@ -187,9 +187,11 @@
         modifyIORef' http2settings $ \old -> updateSettings old alist
         let !frame = settingsFrame setAck []
         sent <- readIORef firstSettings
-        let !frame' = if sent then frame else BS.append initialFrame frame
+        let !setframe
+              | sent      = CSettings               frame alist
+              | otherwise = CSettings0 initialFrame frame alist
         unless sent $ writeIORef firstSettings True
-        enqueueControl controlQ $ CSettings frame' alist
+        enqueueControl controlQ setframe
     return True
 
 control FramePing FrameHeader{flags} bs Context{controlQ} =
@@ -345,3 +347,20 @@
 stream _ _ _ _ st@(Closed (ResetByMe _)) _ = return st
 stream FrameData FrameHeader{streamId} _ _ _ _ = E.throwIO $ StreamError StreamClosed streamId
 stream _ FrameHeader{streamId} _ _ _ _ = E.throwIO $ StreamError ProtocolError streamId
+
+----------------------------------------------------------------
+
+newReadBody :: TQueue ByteString -> IO (IO ByteString)
+newReadBody q = do
+    ref <- newIORef False
+    return $ readBody q ref
+
+readBody :: TQueue ByteString -> IORef Bool -> IO ByteString
+readBody q ref = do
+    eof <- readIORef ref
+    if eof then
+        return ""
+      else do
+        bs <- atomically $ readTQueue q
+        when (bs == "") $ writeIORef ref True
+        return bs
diff --git a/Network/Wai/Handler/Warp/HTTP2/Request.hs b/Network/Wai/Handler/Warp/HTTP2/Request.hs
--- a/Network/Wai/Handler/Warp/HTTP2/Request.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/Request.hs
@@ -3,7 +3,6 @@
 
 module Network.Wai.Handler.Warp.HTTP2.Request (
     mkRequest
-  , newReadBody
   , MkReq
   , ValidHeaders(..)
   , validateHeaders
@@ -12,13 +11,10 @@
 #if __GLASGOW_HASKELL__ < 709
 import Control.Applicative ((<$>))
 #endif
-import Control.Concurrent.STM
-import Control.Monad (when)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as B8
 import Data.CaseInsensitive (mk)
-import Data.IORef (IORef, readIORef, newIORef, writeIORef)
 import Data.Maybe (isJust)
 import qualified Data.Vault.Lazy as Vault
 #if __GLASGOW_HASKELL__ < 709
@@ -30,11 +26,12 @@
 import qualified Network.HTTP.Types as H
 import Network.Socket (SockAddr)
 import Network.Wai
-import Network.Wai.Internal (Request(..))
 import Network.Wai.Handler.Warp.HTTP2.Types
+import Network.Wai.Handler.Warp.HashMap (hashByteString)
 import Network.Wai.Handler.Warp.ReadInt
 import Network.Wai.Handler.Warp.Request (pauseTimeoutKey, getFileInfoKey)
-import Network.Wai.Handler.Warp.Types (InternalInfo(..))
+import Network.Wai.Handler.Warp.Types
+import Network.Wai.Internal (Request(..))
 import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath)
 import qualified Network.Wai.Handler.Warp.Timeout as Timeout
 
@@ -49,23 +46,26 @@
   , vhHeader  :: !RequestHeaders
   } deriving Show
 
-type MkReq = ValidHeaders -> IO ByteString -> Request
+type MkReq = ValidHeaders -> IO ByteString -> (Request,InternalInfo)
 
-mkRequest :: InternalInfo -> S.Settings -> SockAddr -> MkReq
-mkRequest ii settings addr (ValidHeaders m p ma mrng mrr mua _ hdr) body = req
+mkRequest :: InternalInfo1 -> S.Settings -> SockAddr -> MkReq
+mkRequest ii1 settings addr (ValidHeaders m p ma mrng mrr mua _ hdr) body =
+    (req,ii)
   where
     (unparsedPath,query) = B8.break (=='?') p
     !path = H.extractPath unparsedPath
+    !rawPath = if S.settingsNoParsePath settings then unparsedPath else path
+    !h = hashByteString rawPath
     !req = Request {
         requestMethod = m
       , httpVersion = http2ver
-      , rawPathInfo = if S.settingsNoParsePath settings then unparsedPath else path
+      , rawPathInfo = rawPath
       , pathInfo = H.decodePathSegments path
       , rawQueryString = query
       , queryString = H.parseQuery query
       , requestHeaders = case ma of
                            Nothing -> hdr
-                           Just h  -> (mk "host", h) : hdr
+                           Just hv  -> (mk "host", hv) : hdr
       , isSecure = True
       , remoteHost = addr
       , requestBody = body
@@ -76,9 +76,10 @@
       , requestHeaderReferer   = mrr
       , requestHeaderUserAgent = mua
       }
+    !ii = toInternalInfo ii1 h
     !th = threadHandle ii
     !vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)
-                $ Vault.insert getFileInfoKey (fileInfo ii)
+                $ Vault.insert getFileInfoKey (getFileInfo ii)
                   Vault.empty
 
 ----------------------------------------------------------------
@@ -163,21 +164,3 @@
                               in [("cookie",v)]
     isPseudo "" = False
     isPseudo k  = BS.head k == _colon
-
-
-----------------------------------------------------------------
-
-newReadBody :: TQueue ByteString -> IO (IO ByteString)
-newReadBody q = do
-    ref <- newIORef False
-    return $ readBody q ref
-
-readBody :: TQueue ByteString -> IORef Bool -> IO ByteString
-readBody q ref = do
-    eof <- readIORef ref
-    if eof then
-        return ""
-      else do
-        bs <- atomically $ readTQueue q
-        when (bs == "") $ writeIORef ref True
-        return bs
diff --git a/Network/Wai/Handler/Warp/HTTP2/Sender.hs b/Network/Wai/Handler/Warp/HTTP2/Sender.hs
--- a/Network/Wai/Handler/Warp/HTTP2/Sender.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/Sender.hs
@@ -34,8 +34,6 @@
 import Network.Wai.Handler.Warp.FdCache
 import Network.Wai.Handler.Warp.SendFile (positionRead)
 import qualified Network.Wai.Handler.Warp.Timeout as T
-import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
-import System.Posix.Types
 #endif
 
 ----------------------------------------------------------------
@@ -63,10 +61,10 @@
             | O (StreamId,Precedence,Output)
             | Flush
 
-frameSender :: Context -> Connection -> InternalInfo -> S.Settings -> Manager -> IO ()
+frameSender :: Context -> Connection -> S.Settings -> Manager -> IO ()
 frameSender ctx@Context{outputQ,controlQ,connectionWindow,encodeDynamicTable}
             conn@Connection{connWriteBuffer,connBufferSize,connSendAll}
-            ii settings mgr = loop 0 `E.catch` ignore
+            settings mgr = loop 0 `E.catch` ignore
   where
     dequeue off = do
         isEmpty <- isEmptyTQueue controlQ
@@ -86,28 +84,37 @@
         case x of
             C ctl -> do
                 when (off /= 0) $ flushN off
-                cont <- control ctl
-                when cont $ loop 0
+                off' <- control ctl off
+                when (off' >= 0) $ loop off'
             O (_,pre,out) -> do
                 let strm = outputStream out
                 writeIORef (streamPrecedence strm) pre
                 off' <- whenReadyOrEnqueueAgain out off $ output out off
                 case off' of
                     0                -> loop 0
-                    _ | off' > 12288 -> flushN off' >> loop 0 -- fixme: hard-coding
+                    _ | off' > 15872 -> flushN off' >> loop 0 -- fixme: hard-coding
                       | otherwise    -> loop off'
             Flush -> flushN off >> loop 0
 
-    control CFinish         = return False
-    control (CGoaway frame) = connSendAll frame >> return False
-    control (CFrame frame)  = connSendAll frame >> return True
-    control (CSettings frame alist) = do
+    control CFinish         _ = return (-1)
+    control (CGoaway frame) _ = connSendAll frame >> return (-1)
+    control (CFrame frame)  _ = connSendAll frame >> return 0
+    control (CSettings frame alist) _ = do
         connSendAll frame
-        case lookup SettingsHeaderTableSize alist of
-            Nothing  -> return ()
-            Just siz -> setLimitForEncoding siz encodeDynamicTable
-        return True
+        setLimit alist
+        return 0
+    control (CSettings0 frame1 frame2 alist) off = do -- off == 0, just in case
+        let !buf = connWriteBuffer `plusPtr` off
+            !off' = off + BS.length frame1 + BS.length frame2
+        buf' <- copy buf frame1
+        void $ copy buf' frame2
+        setLimit alist
+        return off'
 
+    setLimit alist = case lookup SettingsHeaderTableSize alist of
+        Nothing  -> return ()
+        Just siz -> setLimitForEncoding siz encodeDynamicTable
+
     output (ONext strm curr mtbq) off0 lim = do
         -- Data frame payload
         let !buf = connWriteBuffer `plusPtr` off0
@@ -117,23 +124,23 @@
         maybeEnqueueNext strm mtbq mnext
         return off
 
-    output (ORspn strm rspn) off0 lim = do
+    output (ORspn strm rspn ii) off0 lim = do
         -- Header frame and Continuation frame
         let sid = streamNumber strm
             endOfStream = case rspn of
                 RspnNobody _ _ -> True
                 _              -> False
-        kvlen <- headerContinue sid rspn endOfStream off0
+        kvlen <- headerContinue sid rspn endOfStream off0 ii
         off <- sendHeadersIfNecessary $ off0 + frameHeaderLength + kvlen
         case rspn of
             RspnNobody _ _ -> do
                 closed ctx strm Finished
                 return off
-            RspnFile _ _ h path mpart -> do
+            RspnFile _ _ path mpart -> do
                 -- Data frame payload
                 let payloadOff = off + frameHeaderLength
                 Next datPayloadLen mnext <-
-                    fillFileBodyGetNext conn ii payloadOff lim h path mpart
+                    fillFileBodyGetNext conn ii payloadOff lim path mpart
                 off' <- fillDataHeader strm off datPayloadLen mnext
                 maybeEnqueueNext strm Nothing mnext
                 return off'
@@ -190,7 +197,7 @@
     flushN :: Int -> IO ()
     flushN n = bufferIO connWriteBuffer n connSendAll
 
-    headerContinue sid rspn endOfStream off = do
+    headerContinue sid rspn endOfStream off ii = do
         let !s = rspnStatus rspn
             !h = rspnHeaders rspn
         let !offkv = off + frameHeaderLength
@@ -274,10 +281,10 @@
     (len, signal) <- B.runBuilder bb datBuf room
     return $ nextForBuilder len signal
 
-fillFileBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> Int -> FilePath -> Maybe FilePart -> IO Next
+fillFileBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> FilePath -> Maybe FilePart -> IO Next
 #ifdef WINDOWS
 fillFileBodyGetNext Connection{connWriteBuffer,connBufferSize}
-                        _ off lim _ path mpart = do
+                        _ off lim path mpart = do
     let datBuf = connWriteBuffer `plusPtr` off
         room = min (connBufferSize - off) lim
     (start, bytes) <- fileStartEnd path mpart
@@ -290,13 +297,14 @@
     return $ nextForFile len hdl bytes' (return ())
 #else
 fillFileBodyGetNext Connection{connWriteBuffer,connBufferSize}
-                        ii off lim h path mpart = do
-    (fd, refresh) <- case fdCacher ii of
-        Just fdcache -> getFd' fdcache h path
-        Nothing      -> do
-            fd' <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock=True}
-            th <- T.register (timeoutManager ii) (closeFd fd')
+                        ii off lim path mpart = do
+    (mfd, refresh') <- getFd ii path
+    (fd, refresh) <- case mfd of
+        Nothing -> do
+            fd' <- openFile path
+            th <- T.register (timeoutManager ii) (closeFile fd')
             return (fd', T.tickle th)
+        Just fd  -> return (fd, refresh')
     let datBuf = connWriteBuffer `plusPtr` off
         room = min (connBufferSize - off) lim
     (start, bytes) <- fileStartEnd path mpart
diff --git a/Network/Wai/Handler/Warp/HTTP2/Types.hs b/Network/Wai/Handler/Warp/HTTP2/Types.hs
--- a/Network/Wai/Handler/Warp/HTTP2/Types.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/Types.hs
@@ -41,7 +41,7 @@
 
 ----------------------------------------------------------------
 
-data Input = Input Stream Request
+data Input = Input Stream Request InternalInfo
 
 ----------------------------------------------------------------
 
@@ -54,36 +54,37 @@
 data Rspn = RspnNobody    H.Status H.ResponseHeaders
           | RspnStreaming H.Status H.ResponseHeaders (TBQueue Sequence)
           | RspnBuilder   H.Status H.ResponseHeaders Builder
-          | RspnFile      H.Status H.ResponseHeaders Int FilePath (Maybe FilePart)
+          | RspnFile      H.Status H.ResponseHeaders FilePath (Maybe FilePart)
 
 rspnStatus :: Rspn -> H.Status
-rspnStatus (RspnNobody    s _)        = s
-rspnStatus (RspnStreaming s _ _)      = s
-rspnStatus (RspnBuilder   s _ _)      = s
-rspnStatus (RspnFile      s _ _ _ _ ) = s
+rspnStatus (RspnNobody    s _)      = s
+rspnStatus (RspnStreaming s _ _)    = s
+rspnStatus (RspnBuilder   s _ _)    = s
+rspnStatus (RspnFile      s _ _ _ ) = s
 
 rspnHeaders :: Rspn -> H.ResponseHeaders
-rspnHeaders (RspnNobody    _ h)        = h
-rspnHeaders (RspnStreaming _ h _)      = h
-rspnHeaders (RspnBuilder   _ h _)      = h
-rspnHeaders (RspnFile      _ h _ _ _ ) = h
+rspnHeaders (RspnNobody    _ h)      = h
+rspnHeaders (RspnStreaming _ h _)    = h
+rspnHeaders (RspnBuilder   _ h _)    = h
+rspnHeaders (RspnFile      _ h _ _ ) = h
 
-data Output = ORspn !Stream !Rspn
+data Output = ORspn !Stream !Rspn !InternalInfo
             | ONext !Stream !DynaNext !(Maybe (TBQueue Sequence))
 
 outputStream :: Output -> Stream
-outputStream (ORspn strm _)   = strm
+outputStream (ORspn strm _ _) = strm
 outputStream (ONext strm _ _) = strm
 
 outputMaybeTBQueue :: Output -> Maybe (TBQueue Sequence)
-outputMaybeTBQueue (ORspn _ (RspnStreaming _ _ tbq)) = Just tbq
-outputMaybeTBQueue (ORspn _ _)                       = Nothing
-outputMaybeTBQueue (ONext _ _ mtbq)                  = mtbq
+outputMaybeTBQueue (ORspn _ (RspnStreaming _ _ tbq) _) = Just tbq
+outputMaybeTBQueue (ORspn _ _ _)                       = Nothing
+outputMaybeTBQueue (ONext _ _ mtbq)                    = mtbq
 
 data Control = CFinish
-             | CGoaway   !ByteString
-             | CFrame    !ByteString
-             | CSettings !ByteString !SettingsList
+             | CGoaway    !ByteString
+             | CFrame     !ByteString
+             | CSettings  !ByteString !SettingsList
+             | CSettings0 !ByteString !ByteString !SettingsList
 
 ----------------------------------------------------------------
 
diff --git a/Network/Wai/Handler/Warp/HTTP2/Worker.hs b/Network/Wai/Handler/Warp/HTTP2/Worker.hs
--- a/Network/Wai/Handler/Warp/HTTP2/Worker.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/Worker.hs
@@ -20,7 +20,6 @@
 import qualified Control.Exception as E
 import Control.Monad (when)
 import Data.ByteString.Builder (byteString)
-import Data.Hashable (hash)
 import qualified Network.HTTP.Types as H
 import Network.HTTP2
 import Network.Wai
@@ -42,29 +41,31 @@
 -- | The wai definition is 'type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived'.
 --   This type implements the second argument (Response -> IO ResponseReceived)
 --   with extra arguments.
-type Responder = ThreadContinue -> T.Handle -> Stream -> Request ->
+type Responder = InternalInfo -> ThreadContinue -> Stream -> Request ->
                  Response -> IO ResponseReceived
 
 -- | This function is passed to workers.
 --   They also pass 'Response's from 'Application's to this function.
 --   This function enqueues commands for the HTTP/2 sender.
-response :: InternalInfo -> S.Settings -> Context -> Manager -> Responder
-response ii settings Context{outputQ} mgr tconf th strm req rsp
-  | R.hasBody s0 = case rsp of
-    ResponseStream _ _ strmbdy
-      | isHead             -> responseNoBody s0 hs0
-      | otherwise          -> responseStreaming strmbdy
-    ResponseBuilder _ _ b
-      | isHead             -> responseNoBody s0 hs0
-      | otherwise          -> responseBuilderBody s0 hs0 b
-    ResponseFile _ _ p mp  -> responseFileXXX p mp
-    ResponseRaw _ _        -> error "HTTP/2 does not support ResponseRaw"
-  | otherwise               = responseNoBody s0 hs0
+response :: S.Settings -> Context -> Manager -> Responder
+response settings Context{outputQ} mgr ii tconf strm req rsp = case rsp of
+  ResponseStream s0 hs0 strmbdy
+    | noBody s0          -> responseNoBody s0 hs0
+    | isHead             -> responseNoBody s0 hs0
+    | otherwise          -> responseStreaming s0 hs0 strmbdy
+  ResponseBuilder s0 hs0 b
+    | noBody s0          -> responseNoBody s0 hs0
+    | isHead             -> responseNoBody s0 hs0
+    | otherwise          -> responseBuilderBody s0 hs0 b
+  ResponseFile s0 hs0 p mp
+    | noBody s0          -> responseNoBody s0 hs0
+    | otherwise          -> responseFileXXX s0 hs0 p mp
+  ResponseRaw _ _        -> error "HTTP/2 does not support ResponseRaw"
   where
+    noBody = not . R.hasBody
     !isHead = requestMethod req == H.methodHead
-    !s0 = responseStatus rsp
-    !hs0 = responseHeaders rsp
     !logger = S.settingsLogger settings
+    !th = threadHandle ii
 
     -- Ideally, log messages should be written when responses are
     -- actually sent. But there is no way to keep good memory usage
@@ -76,7 +77,7 @@
         logger req s Nothing
         setThreadContinue tconf True
         let rspn = RspnNobody s hs
-            out = ORspn strm rspn
+            out = ORspn strm rspn ii
         enqueueOutput outputQ out
         return ResponseReceived
 
@@ -84,42 +85,39 @@
         logger req s Nothing
         setThreadContinue tconf True
         let rspn = RspnBuilder s hs bdy
-            out = ORspn strm rspn
+            out = ORspn strm rspn ii
         enqueueOutput outputQ out
         return ResponseReceived
 
-    responseFileXXX path Nothing = do
-        let !h = hash $ rawPathInfo req
-        efinfo <- E.try $ fileInfo' ii h path
+    responseFileXXX _ hs0 path Nothing = do
+        efinfo <- E.try $ getFileInfo ii path
         case efinfo of
-            Left (_ex :: E.IOException) -> response404
+            Left (_ex :: E.IOException) -> response404 hs0
             Right finfo -> case conditionalRequest finfo hs0 (indexRequestHeader (requestHeaders req)) of
                  WithoutBody s         -> responseNoBody s hs0
-                 WithBody s hs beg len -> responseFile2XX s hs h path (Just (FilePart beg len (fileInfoSize finfo)))
+                 WithBody s hs beg len -> responseFile2XX s hs path (Just (FilePart beg len (fileInfoSize finfo)))
 
-    responseFileXXX path mpart = responseFile2XX s0 hs0 h path mpart
-      where
-        !h = hash $ rawPathInfo req
+    responseFileXXX s0 hs0 path mpart = responseFile2XX s0 hs0 path mpart
 
-    responseFile2XX s hs h path mpart
+    responseFile2XX s hs path mpart
       | isHead    = do
           logger req s Nothing
           responseNoBody s hs
       | otherwise = do
           logger req s (filePartByteCount <$> mpart)
           setThreadContinue tconf True
-          let rspn = RspnFile s hs h path mpart
-              out = ORspn strm rspn
+          let rspn = RspnFile s hs path mpart
+              out = ORspn strm rspn ii
           enqueueOutput outputQ out
           return ResponseReceived
 
-    response404 = responseBuilderBody s hs body
+    response404 hs0 = responseBuilderBody s hs body
       where
         s = H.notFound404
         hs = R.replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
         body = byteString "File not found"
 
-    responseStreaming strmbdy = do
+    responseStreaming s0 hs0 strmbdy = do
         logger req s0 Nothing
         -- We must not exit this WAI application.
         -- If the application exits, streaming would be also closed.
@@ -134,7 +132,7 @@
         -- So, let's serialize 'Builder' with a designated queue.
         tbq <- newTBQueueIO 10 -- fixme: hard coding: 10
         let rspn = RspnStreaming s0 hs0 tbq
-            out = ORspn strm rspn
+            out = ORspn strm rspn ii
         enqueueOutput outputQ out
         let push b = do
               atomically $ writeTBQueue tbq (SBuilder b)
@@ -155,11 +153,11 @@
         setThreadContinue tcont True
         ex <- E.try $ do
             T.pause th
-            inp@(Input strm req) <- atomically $ readTQueue inputQ
+            inp@(Input strm req ii) <- atomically $ readTQueue inputQ
             setStreamInfo sinfo inp
             T.resume th
             T.tickle th
-            app req $ responder tcont th strm req
+            app req $ responder ii tcont strm req
         cont1 <- case ex of
             Right ResponseReceived -> return True
             Left  e@(SomeException _)
@@ -179,7 +177,7 @@
         minp <- getStreamInfo sinfo
         case minp of
             Nothing               -> return ()
-            Just (Input strm req) -> do
+            Just (Input strm req _ii) -> do
                 closed ctx strm Killed
                 let frame = resetFrame InternalError (streamNumber strm)
                 enqueueControl controlQ $ CFrame frame
diff --git a/Network/Wai/Handler/Warp/HashMap.hs b/Network/Wai/Handler/Warp/HashMap.hs
--- a/Network/Wai/Handler/Warp/HashMap.hs
+++ b/Network/Wai/Handler/Warp/HashMap.hs
@@ -1,5 +1,7 @@
 module Network.Wai.Handler.Warp.HashMap where
 
+import Data.ByteString (ByteString)
+import Data.Hashable (hash)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as I
 import Data.Map.Strict (Map)
@@ -7,6 +9,9 @@
 
 type Hash = Int
 newtype HashMap k v = HashMap (IntMap (Map k v))
+
+hashByteString :: ByteString -> Hash
+hashByteString = hash
 
 empty :: HashMap k v
 empty = HashMap $ I.empty
diff --git a/Network/Wai/Handler/Warp/MultiMap.hs b/Network/Wai/Handler/Warp/MultiMap.hs
--- a/Network/Wai/Handler/Warp/MultiMap.hs
+++ b/Network/Wai/Handler/Warp/MultiMap.hs
@@ -1,240 +1,90 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, BangPatterns #-}
 
 module Network.Wai.Handler.Warp.MultiMap (
     MMap
-  , Some(..)
+  , isEmpty
   , empty
   , singleton
   , insert
   , search
   , searchWith
-  , isEmpty
-  , valid
   , pruneWith
-  , fromList
   , toList
-  , fromSortedList
-  , toSortedList
   , merge
   ) where
 
 #if __GLASGOW_HASKELL__ < 709
 import Control.Applicative ((<$>))
 #endif
-import Data.List (foldl')
-
-----------------------------------------------------------------
-
--- | One ore more list to implement multimap.
-data Some a = One !a
-            | Tom !a !(Some a) -- Two or more
-            deriving (Eq,Show)
-
--- This is slow but assuming rarely used.
-snoc :: Some a -> a -> Some a
-snoc (One x) y    = Tom x (One y)
-snoc (Tom x xs) y = Tom x (snoc xs y)
-
-top :: Some a -> a
-top (One x)   = x
-top (Tom x _) = x
-
-----------------------------------------------------------------
-
--- | Red black tree as multimap.
-data MMap k v = Leaf -- color is Black
-              | Node Color !(MMap k v) !k !(Some v) !(MMap k v)
-              deriving (Show)
-
-data Color = B -- ^ Black
-           | R -- ^ Red
-           deriving (Eq, Show)
-
-----------------------------------------------------------------
-
-instance (Eq k, Eq v) => Eq (MMap k v) where
-    t1 == t2 = toSortedList t1 == toSortedList t2
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as I
+import qualified Network.Wai.Handler.Warp.Some as S
 
 ----------------------------------------------------------------
 
--- | O(log N)
-search :: Ord k => k -> MMap k v -> Maybe v
-search _ Leaf = Nothing
-search xk (Node _ l k v r) = case compare xk k of
-    LT -> search xk l
-    GT -> search xk r
-    EQ -> Just $ top v
-
--- | O(log N)
-searchWith :: Ord k => k -> (Some v -> Maybe v) -> MMap k v -> Maybe v
-searchWith _ _ Leaf = Nothing
-searchWith xk f (Node _ l k v r) = case compare xk k of
-    LT -> searchWith xk f l
-    GT -> searchWith xk f r
-    EQ -> f v
+type MMap v = IntMap (S.Some v)
 
 ----------------------------------------------------------------
 
 -- | O(1)
-isEmpty :: MMap k v -> Bool
-isEmpty Leaf = True
-isEmpty _    = False
+isEmpty :: MMap v -> Bool
+isEmpty = I.null
 
 -- | O(1)
-empty :: MMap k v
-empty = Leaf
+empty :: MMap v
+empty = I.empty
 
 ----------------------------------------------------------------
 
 -- | O(1)
-singleton :: Ord k => k -> v -> MMap k v
-singleton k v = Node B Leaf k (One v) Leaf
-
-----------------------------------------------------------------
-
--- | O(log N)
-insert :: Ord k => k -> v -> MMap k v -> MMap k v
-insert kx kv t = turnB (insert' kx kv t)
-
-insert' :: Ord k => k -> v -> MMap k v -> MMap k v
-insert' xk xv Leaf = Node R Leaf xk (One xv) Leaf
-insert' xk xv (Node B l k v r) = case compare xk k of
-    LT -> balanceL' (insert' xk xv l) k v r
-    GT -> balanceR' l k v (insert' xk xv r)
-    EQ -> Node B l k (snoc v xv) r
-insert' xk xv (Node R l k v r) = case compare xk k of
-    LT -> Node R (insert' xk xv l) k v r
-    GT -> Node R l k v (insert' xk xv r)
-    EQ -> Node R l k (snoc v xv) r
-
-balanceL' :: MMap k v -> k -> Some v -> MMap k v -> MMap k v
-balanceL' (Node R (Node R a xk xv b) yk yv c) zk zv d =
-    Node R (Node B a xk xv b) yk yv (Node B c zk zv d)
-balanceL' (Node R a xk xv (Node R b yk yv c)) zk zv d =
-    Node R (Node B a xk xv b) yk yv (Node B c zk zv d)
-balanceL' l k v r = Node B l k v r
-
-balanceR' :: MMap k v -> k -> Some v -> MMap k v -> MMap k v
-balanceR' a xk xv (Node R b yk yv (Node R c zk zv d)) =
-    Node R (Node B a xk xv b) yk yv (Node B c zk zv d)
-balanceR' a xk xv (Node R (Node R b yk yv c) zk zv d) =
-    Node R (Node B a xk xv b) yk yv (Node B c zk zv d)
-balanceR' l xk xv r = Node B l xk xv r
-
-turnB :: MMap k v -> MMap k v
-turnB Leaf             = error "turnB"
-turnB (Node _ l k v r) = Node B l k v r
+singleton :: Int -> v -> MMap v
+singleton k v = I.singleton k (S.singleton v)
 
 ----------------------------------------------------------------
 
--- | O(N log N)
-fromList :: Ord k => [(k,v)] -> MMap k v
-fromList = foldl' (\t (k,v) -> insert k v t) empty
+-- | O(log n)
+search :: Int -> MMap v -> Maybe v
+search k m = case I.lookup k m of
+    Nothing -> Nothing
+    Just s  -> Just $! S.top s
 
--- | O(N)
-toList :: MMap k v -> [(k,v)]
-toList t = inorder t []
-  where
-    inorder Leaf xs = xs
-    inorder (Node _ l k v r) xs = inorder l (pairs k v ++ inorder r xs)
-    pairs k (One v) = [(k,v)]
-    pairs k (Tom v vs) = (k,v) : pairs k vs
+-- | O(log n)
+searchWith :: Int -> (v -> Bool) -> MMap v -> Maybe v
+searchWith k f m = case I.lookup k m of
+    Nothing -> Nothing
+    Just s  -> S.lookupWith f s
 
 ----------------------------------------------------------------
 
--- | O(N)
--- "Constructing Red-Black Trees" by Ralf Hinze
-fromSortedList :: Ord k => [(k,Some v)] -> MMap k v
-fromSortedList = linkAll . foldr add []
-
-data Digit k v = Uno k (Some v) (MMap k v)
-               | Due k (Some v) (MMap k v) k (Some v) (MMap k v)
-               deriving (Eq,Show)
-
-incr :: Digit k v -> [Digit k v] -> [Digit k v]
-incr (Uno k v t) [] = [Uno k v t]
-incr (Uno k1 v1 t1) (Uno k2 v2 t2 : ps) = Due k1 v1 t1 k2 v2 t2 : ps
-incr (Uno k1 v1 t1) (Due k2 v2 t2 k3 v3 t3 : ps) = Uno k1 v1 t1 : incr (Uno k2 v2 (Node B t2 k3 v3 t3)) ps
-incr _ _ = error "incr"
-
-add :: (k,Some v) -> [Digit k v] -> [Digit k v]
-add (k,v) ps = incr (Uno k v Leaf) ps
-
-linkAll :: [Digit k v] -> MMap k v
-linkAll = foldl' link Leaf
-
-link :: MMap k v -> Digit k v -> MMap k v
-link l (Uno k v t) = Node B l k v t
---link l (Due k1 v1 t1 k2 v2 t2) = Node B (Node R l k1 v1 t1) k2 v2 t2
-link l (Due k1 v1 t1 k2 v2 t2) = Node B l k1 v1 (Node R t1 k2 v2 t2)
+-- | O(log n)
+insert :: Int -> v -> MMap v -> MMap v
+insert k v m = I.insertWith S.union k (S.singleton v) m
 
 ----------------------------------------------------------------
 
--- | O(N)
-toSortedList :: MMap k v -> [(k,Some v)]
-toSortedList t = inorder t []
+-- | O(n)
+toList :: MMap v -> [v]
+toList m = concatMap f $ I.toAscList m
   where
-    inorder Leaf xs = xs
-    inorder (Node _ l k v r) xs = inorder l ((k,v) : inorder r xs)
+    f (_,s) = S.toList s
 
 ----------------------------------------------------------------
 
--- | O(N)
-pruneWith :: Ord k =>
-             MMap k v
-          -> (k -> Some v -> IO [(k, Some v)])
-          -> IO (MMap k v)
-pruneWith t run = fromSortedList <$> inorder t []
+-- | O(n)
+pruneWith :: MMap v
+          -> (v -> IO Bool)
+          -> IO (MMap v)
+pruneWith m action = I.fromAscList <$> go (I.toDescList m) []
   where
-    inorder Leaf xs = return xs
-    inorder (Node _ l k v r) xs = do
-        ys <- run k v
-        zs <- inorder r xs
-        inorder l (ys ++ zs)
+    go []          acc = return acc
+    go ((k,s):kss) acc = do
+        mt <- S.prune action s
+        case mt of
+            Nothing -> go kss acc
+            Just t  -> go kss ((k,t) : acc)
 
 ----------------------------------------------------------------
 
--- O(N log N) where N is the size of the second argument
-merge :: Ord k => MMap k v -> MMap k v -> MMap k v
-merge base m = foldl' ins base xs
-  where
-    ins t (k,v) = insert k v t
-    xs = toList m
-
-----------------------------------------------------------------
--- for testing
-
-valid :: Ord k => MMap k v -> Bool
-valid t = isBalanced t && isOrdered t
-
-isBalanced :: MMap k v -> Bool
-isBalanced t = isBlackSame t && isRedSeparate t
-
-isBlackSame :: MMap k v -> Bool
-isBlackSame t = all (n==) ns
-  where
-    n:ns = blacks t
-
-blacks :: MMap k v -> [Int]
-blacks = blacks' 0
-  where
-    blacks' n Leaf = [n+1]
-    blacks' n (Node R l _ _ r) = blacks' n  l ++ blacks' n  r
-    blacks' n (Node B l _ _ r) = blacks' n' l ++ blacks' n' r
-      where
-        n' = n + 1
-
-isRedSeparate :: MMap k v -> Bool
-isRedSeparate = reds B
-
-reds :: Color -> MMap k v -> Bool
-reds _ Leaf = True
-reds R (Node R _ _ _ _) = False
-reds _ (Node c l _ _ r) = reds c l && reds c r
-
-isOrdered :: Ord k => MMap k v -> Bool
-isOrdered t = ordered $ toSortedList t
-  where
-    ordered [] = True
-    ordered [_] = True
-    ordered (x:y:xys) = fst x <= fst y && ordered (y:xys)
+-- O(n + m) where N is the size of the second argument
+merge :: MMap v -> MMap v -> MMap v
+merge m1 m2 = I.unionWith S.union m1 m2
diff --git a/Network/Wai/Handler/Warp/Request.hs b/Network/Wai/Handler/Warp/Request.hs
--- a/Network/Wai/Handler/Warp/Request.hs
+++ b/Network/Wai/Handler/Warp/Request.hs
@@ -23,6 +23,7 @@
 import Network.Wai
 import Network.Wai.Handler.Warp.Conduit
 import Network.Wai.Handler.Warp.FileInfoCache
+import Network.Wai.Handler.Warp.HashMap (hashByteString)
 import Network.Wai.Handler.Warp.Header
 import Network.Wai.Handler.Warp.ReadInt
 import Network.Wai.Handler.Warp.RequestHeader
@@ -47,19 +48,20 @@
 --   to create 'Request'.
 recvRequest :: Settings
             -> Connection
-            -> InternalInfo
+            -> InternalInfo1
             -> SockAddr -- ^ Peer's address.
             -> Source -- ^ Where HTTP request comes from.
             -> IO (Request
                   ,Maybe (I.IORef Int)
                   ,IndexedHeader
-                  ,IO ByteString) -- ^
+                  ,IO ByteString
+                  ,InternalInfo) -- ^
             -- 'Request' passed to 'Application',
             -- how many bytes remain to be consumed, if known
             -- 'IndexedHeader' of HTTP request for internal use,
             -- Body producing action used for flushing the request body
 
-recvRequest settings conn ii addr src = do
+recvRequest settings conn ii1 addr src = do
     hdrlines <- headerLines src
     (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
     let idxhdr = indexRequestHeader hdr
@@ -67,6 +69,13 @@
         cl = idxhdr ! fromEnum ReqContentLength
         te = idxhdr ! fromEnum ReqTransferEncoding
         handle100Continue = handleExpect conn httpversion expect
+        rawPath = if settingsNoParsePath settings then unparsedPath else path
+        h = hashByteString rawPath
+        ii = toInternalInfo ii1 h
+        th = threadHandle ii
+        vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)
+                   $ Vault.insert getFileInfoKey (getFileInfo ii)
+                     Vault.empty
     (rbody, remainingRef, bodyLength) <- bodyAndSource src cl te
     -- body producing function which will produce '100-continue', if needed
     rbody' <- timeoutBody remainingRef th rbody handle100Continue
@@ -76,7 +85,7 @@
             requestMethod     = method
           , httpVersion       = httpversion
           , pathInfo          = H.decodePathSegments path
-          , rawPathInfo       = if settingsNoParsePath settings then unparsedPath else path
+          , rawPathInfo       = rawPath
           , rawQueryString    = query
           , queryString       = H.parseQuery query
           , requestHeaders    = hdr
@@ -90,12 +99,7 @@
           , requestHeaderReferer   = idxhdr ! fromEnum ReqReferer
           , requestHeaderUserAgent = idxhdr ! fromEnum ReqUserAgent
           }
-    return (req, remainingRef, idxhdr, rbodyFlush)
-  where
-    th = threadHandle ii
-    vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)
-               $ Vault.insert getFileInfoKey (fileInfo ii)
-                 Vault.empty
+    return (req, remainingRef, idxhdr, rbodyFlush, ii)
 
 ----------------------------------------------------------------
 
diff --git a/Network/Wai/Handler/Warp/Response.hs b/Network/Wai/Handler/Warp/Response.hs
--- a/Network/Wai/Handler/Warp/Response.hs
+++ b/Network/Wai/Handler/Warp/Response.hs
@@ -36,7 +36,6 @@
 import Data.ByteString.Builder.Extra (flush)
 import qualified Data.CaseInsensitive as CI
 import Data.Function (on)
-import Data.Hashable (hash)
 import Data.List (deleteBy)
 import Data.Maybe
 #if MIN_VERSION_base(4,5,0)
@@ -57,9 +56,6 @@
 import Network.Wai
 import Network.Wai.Handler.Warp.Buffer (toBuilderBuffer)
 import qualified Network.Wai.Handler.Warp.Date as D
-#ifndef WINDOWS
-import qualified Network.Wai.Handler.Warp.FdCache as F
-#endif
 import Network.Wai.Handler.Warp.File
 import Network.Wai.Handler.Warp.Header
 import Network.Wai.Handler.Warp.IO (toBufIOWith)
@@ -148,14 +144,14 @@
         -- and status, the response to HEAD is processed here.
         --
         -- See definition of rsp below for proper body stripping.
-        (ms, mlen) <- sendRsp conn ii req ver s hs rsp
+        (ms, mlen) <- sendRsp conn ii ver s hs rsp
         case ms of
             Nothing         -> return ()
             Just realStatus -> logger req realStatus mlen
         T.tickle th
         return ret
       else do
-        _ <- sendRsp conn ii req ver s hs RspNoBody
+        _ <- sendRsp conn ii ver s hs RspNoBody
         logger req s Nothing
         T.tickle th
         return isPersist
@@ -167,8 +163,8 @@
     hs0 = sanitizeHeaders $ responseHeaders response
     rspidxhdr = indexResponseHeader hs0
     th = threadHandle ii
-    dc = dateCacher ii
-    addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr
+    getdate = getDate ii
+    addServerAndDate = addDate getdate rspidxhdr . addServer defServer rspidxhdr
     (isPersist,isChunked0) = infoFromRequest req reqidxhdr
     isChunked = not isHead && isChunked0
     (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr (isPersist,isChunked)
@@ -225,7 +221,6 @@
 
 sendRsp :: Connection
         -> InternalInfo
-        -> Request
         -> H.HttpVersion
         -> H.Status
         -> H.ResponseHeaders
@@ -234,7 +229,7 @@
 
 ----------------------------------------------------------------
 
-sendRsp conn _ _ ver s hs RspNoBody = do
+sendRsp conn _ ver s hs RspNoBody = do
     -- Not adding Content-Length.
     -- User agents treats it as Content-Length: 0.
     composeHeader ver s hs >>= connSendAll conn
@@ -242,7 +237,7 @@
 
 ----------------------------------------------------------------
 
-sendRsp conn _ _ ver s hs (RspBuilder body needsChunked) = do
+sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do
     header <- composeHeaderBuilder ver s hs needsChunked
     let hdrBdy
          | needsChunked = header <> chunkedTransferEncoding body
@@ -255,7 +250,7 @@
 
 ----------------------------------------------------------------
 
-sendRsp conn _ _ ver s hs (RspStream streamingBody needsChunked th) = do
+sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do
     header <- composeHeaderBuilder ver s hs needsChunked
     (recv, finish) <- newBlazeRecv $ reuseBufferStrategy
                     $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)
@@ -279,7 +274,7 @@
 
 ----------------------------------------------------------------
 
-sendRsp conn _ _ _ _ _ (RspRaw withApp src tickle) = do
+sendRsp conn _ _ _ _ (RspRaw withApp src tickle) = do
     withApp recv send
     return (Nothing, Nothing)
   where
@@ -293,10 +288,9 @@
 
 -- Sophisticated WAI applications.
 -- We respect s0. s0 MUST be a proper value.
-sendRsp conn ii req ver s0 hs0 (RspFile path (Just part) _ isHead hook) =
-    sendRspFile2XX conn ii req ver s0 hs h path beg len isHead hook
+sendRsp conn ii ver s0 hs0 (RspFile path (Just part) _ isHead hook) =
+    sendRspFile2XX conn ii ver s0 hs path beg len isHead hook
   where
-    h = hash $ rawPathInfo req
     beg = filePartOffset part
     len = filePartByteCount part
     hs = addContentHeadersForFilePart hs0 part
@@ -305,60 +299,47 @@
 
 -- Simple WAI applications.
 -- Status is ignored
-sendRsp conn ii req ver _ hs0 (RspFile path Nothing idxhdr isHead hook) = do
-    let h = hash $ rawPathInfo req
-    efinfo <- E.try $ fileInfo' ii h path
+sendRsp conn ii ver _ hs0 (RspFile path Nothing idxhdr isHead hook) = do
+    efinfo <- E.try $ getFileInfo ii path
     case efinfo of
         Left (_ex :: E.IOException) ->
 #ifdef WARP_DEBUG
           print _ex >>
 #endif
-          sendRspFile404 conn ii req ver hs0
+          sendRspFile404 conn ii ver hs0
         Right finfo -> case conditionalRequest finfo hs0 idxhdr of
-          WithoutBody s         -> sendRsp conn ii req ver s hs0 RspNoBody
-          WithBody s hs beg len -> sendRspFile2XX conn ii req ver s hs h path beg len isHead hook
+          WithoutBody s         -> sendRsp conn ii ver s hs0 RspNoBody
+          WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs path beg len isHead hook
 
 ----------------------------------------------------------------
 
 sendRspFile2XX :: Connection
                -> InternalInfo
-               -> Request
                -> H.HttpVersion
                -> H.Status
                -> H.ResponseHeaders
-               -> Hash
                -> FilePath
                -> Integer
                -> Integer
                -> Bool
                -> IO ()
                -> IO (Maybe H.Status, Maybe Integer)
-sendRspFile2XX conn ii req ver s hs h path beg len isHead hook
-  | isHead = sendRsp conn ii req ver s hs RspNoBody
+sendRspFile2XX conn ii ver s hs path beg len isHead hook
+  | isHead = sendRsp conn ii ver s hs RspNoBody
   | otherwise = do
       lheader <- composeHeader ver s hs
-#ifdef WINDOWS
-      let fid = FileId path Nothing
-          hook' = hook
-#else
-      (mfd, hook') <- case fdCacher ii of
-         -- settingsFdCacheDuration is 0
-         Nothing  -> return (Nothing, hook)
-         Just fdc -> do
-            (fd, fresher) <- F.getFd' fdc h path
-            return (Just fd, hook >> fresher)
+      (mfd, fresher) <- getFd ii path
       let fid = FileId path mfd
-#endif
+          hook' = hook >> fresher
       connSendFile conn fid beg len hook' [lheader]
       return (Just s, Just len)
 
 sendRspFile404 :: Connection
                -> InternalInfo
-               -> Request
                -> H.HttpVersion
                -> H.ResponseHeaders
                -> IO (Maybe H.Status, Maybe Integer)
-sendRspFile404 conn ii req ver hs0 = sendRsp conn ii req ver s hs (RspBuilder body True)
+sendRspFile404 conn ii ver hs0 = sendRsp conn ii ver s hs (RspBuilder body True)
   where
     s = H.notFound404
     hs =  replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
@@ -435,10 +416,10 @@
 addTransferEncoding hdrs = ("transfer-encoding", "chunked") : hdrs
 #endif
 
-addDate :: D.DateCache -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders
-addDate dc rspidxhdr hdrs = case rspidxhdr ! fromEnum ResDate of
+addDate :: IO D.GMTDate -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders
+addDate getdate rspidxhdr hdrs = case rspidxhdr ! fromEnum ResDate of
     Nothing -> do
-        gmtdate <- D.getDate dc
+        gmtdate <- getdate
         return $ (H.hDate, gmtdate) : hdrs
     Just _ -> return hdrs
 
diff --git a/Network/Wai/Handler/Warp/Run.hs b/Network/Wai/Handler/Warp/Run.hs
--- a/Network/Wai/Handler/Warp/Run.hs
+++ b/Network/Wai/Handler/Warp/Run.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE BangPatterns #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
 module Network.Wai.Handler.Warp.Run where
@@ -22,7 +23,7 @@
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.Streaming.Network (bindPortTCP)
 import Network (sClose, Socket)
-import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6))
+import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6), setSocketOption, SocketOption(..))
 import qualified Network.Socket.ByteString as Sock
 import Network.Wai
 import Network.Wai.Handler.Warp.Buffer
@@ -47,7 +48,6 @@
 #if WINDOWS
 import Network.Wai.Handler.Warp.Windows
 #else
-import System.Posix.IO (FdOption(CloseOnExec), setFdOption)
 import Network.Socket (fdSocket)
 #endif
 
@@ -130,6 +130,7 @@
         (s, sa) <- accept socket
 #endif
         setSocketCloseOnExec s
+        setSocketOption s NoDelay 1
         conn <- socketConnection s
         return (conn, sa)
 
@@ -171,22 +172,23 @@
 runSettingsConnectionMakerSecure set getConnMaker app = do
     settingsBeforeMainLoop set
     counter <- newCounter
-    withII $ acceptConnection set getConnMaker app counter
+    withII0 $ acceptConnection set getConnMaker app counter
   where
-    withII action =
+    withII0 action =
+        withTimeoutManager $ \tm ->
         D.withDateCache $ \dc ->
-        F.withFdCache fdCacheDurationInSeconds $ \fc ->
-        I.withFileInfoCache fdFileInfoDurationInSeconds $ \get get' ->
-        withTimeoutManager $ \tm -> do
-            let ii0 = InternalInfo undefined tm fc get get' dc -- fixme: undefined
+        F.withFdCache fdCacheDurationInSeconds $ \fdc ->
+        I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do
+            let ii0 = InternalInfo0 tm dc fdc fic
             action ii0
 
-    fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
-    fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000
+    !fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
+    !fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000
+    !timeoutInSeconds = settingsTimeout set * 1000000
     withTimeoutManager f = case settingsManager set of
         Just tm -> f tm
         Nothing -> bracket
-                   (T.initialize $ settingsTimeout set * 1000000)
+                   (T.initialize timeoutInSeconds)
                    T.stopManager
                    f
 
@@ -207,7 +209,7 @@
                  -> IO (IO (Connection, Transport), SockAddr)
                  -> Application
                  -> Counter
-                 -> InternalInfo
+                 -> InternalInfo0
                  -> IO ()
 acceptConnection set getConnMaker app counter ii0 = do
     -- First mask all exceptions in acceptLoop. This is necessary to
@@ -257,7 +259,7 @@
      -> SockAddr
      -> Application
      -> Counter
-     -> InternalInfo
+     -> InternalInfo0
      -> IO ()
 fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
     -- Run the connection maker to get a new connection, and ensure
@@ -274,9 +276,9 @@
 
     -- We need to register a timeout handler for this thread, and
     -- cancel that handler as soon as we exit.
-    bracket (T.registerKillThread (timeoutManager ii0)) T.cancel $ \th ->
+    bracket (T.registerKillThread (timeoutManager0 ii0)) T.cancel $ \th ->
 
-    let ii = ii0 { threadHandle = th }
+    let ii1 = toInternalInfo1 ii0 th
         -- We now have fully registered a connection close handler
         -- in the case of all exceptions, so it is safe to one
         -- again allow async exceptions.
@@ -290,7 +292,7 @@
 
        -- Actually serve this connection.
        -- bracket with closeConn above ensures the connection is closed.
-       when goingon $ serveConnection conn ii addr transport set app
+       when goingon $ serveConnection conn ii1 addr transport set app
   where
     closeConn (conn, _transport) = connClose conn
 
@@ -298,13 +300,13 @@
     onClose adr _ = decrease counter >> settingsOnClose set adr
 
 serveConnection :: Connection
-                -> InternalInfo
+                -> InternalInfo1
                 -> SockAddr
                 -> Transport
                 -> Settings
                 -> Application
                 -> IO ()
-serveConnection conn ii origAddr transport settings app = do
+serveConnection conn ii1 origAddr transport settings app = do
     -- fixme: Upgrading to HTTP/2 should be supported.
     (h2,bs) <- if isHTTP2 transport then
                    return (True, "")
@@ -317,7 +319,7 @@
     if settingsHTTP2Enabled settings && h2 then do
         recvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
         -- fixme: origAddr
-        http2 conn ii origAddr transport settings recvN app
+        http2 conn ii1 origAddr transport settings recvN app
       else do
         istatus <- newIORef False
         src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))
@@ -368,7 +370,7 @@
 
     decodeAscii = map (chr . fromEnum) . S.unpack
 
-    th = threadHandle ii
+    th = threadHandle1 ii1
 
     shouldSendErrorResponse se
         | Just ConnectionClosedByPeer <- fromException se = False
@@ -376,17 +378,19 @@
 
     sendErrorResponse addr istatus e = do
         status <- readIORef istatus
-        when (shouldSendErrorResponse e && status) $ void $
-            sendResponse settings conn ii (dummyreq addr) defaultIndexRequestHeader (return S.empty) (errorResponse e)
+        when (shouldSendErrorResponse e && status) $ do
+           let ii = toInternalInfo ii1 0 -- dummy
+               dreq = dummyreq addr
+           void $ sendResponse settings conn ii dreq defaultIndexRequestHeader (return S.empty) (errorResponse e)
 
     dummyreq addr = defaultRequest { remoteHost = addr }
 
     errorResponse e = settingsOnExceptionResponse settings e
 
     http1 addr istatus src = do
-        (req', mremainingRef, idxhdr, nextBodyFlush) <- recvRequest settings conn ii addr src
+        (req', mremainingRef, idxhdr, nextBodyFlush, ii) <- recvRequest settings conn ii1 addr src
         let req = req' { isSecure = isTransportSecure transport }
-        keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush
+        keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush ii
             `E.catch` \e -> do
                 -- Call the user-supplied exception handlers, passing the request.
                 sendErrorResponse addr istatus e
@@ -395,7 +399,7 @@
                 return False
         when keepAlive $ http1 addr istatus src
 
-    processRequest istatus src req mremainingRef idxhdr nextBodyFlush = do
+    processRequest istatus src req mremainingRef idxhdr nextBodyFlush ii = do
         -- Let the application run for as long as it wants
         T.pause th
 
@@ -489,8 +493,7 @@
 #if WINDOWS
 setSocketCloseOnExec _ = return ()
 #else
-setSocketCloseOnExec socket =
-    setFdOption (fromIntegral $ fdSocket socket) CloseOnExec True
+setSocketCloseOnExec socket = F.setFileCloseOnExec $ fromIntegral $ fdSocket socket
 #endif
 
 gracefulShutdown :: Counter -> IO ()
diff --git a/Network/Wai/Handler/Warp/SendFile.hs b/Network/Wai/Handler/Warp/SendFile.hs
--- a/Network/Wai/Handler/Warp/SendFile.hs
+++ b/Network/Wai/Handler/Warp/SendFile.hs
@@ -30,7 +30,7 @@
 import Foreign.C.Types
 import Foreign.Ptr (Ptr, castPtr, plusPtr)
 import Network.Sendfile
-import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
+import Network.Wai.Handler.Warp.FdCache (openFile, closeFile)
 import System.Posix.Types
 #endif
 
@@ -129,10 +129,10 @@
     path = fileIdPath fid
     setup = case fileIdFd fid of
        Just fd -> return fd
-       Nothing -> openFd path ReadOnly Nothing defaultFileFlags{nonBlock=True}
+       Nothing -> openFile path
     teardown fd = case fileIdFd fid of
        Just _  -> return ()
-       Nothing -> closeFd fd
+       Nothing -> closeFile fd
     loop fd len off
       | len <= 0  = return ()
       | otherwise = do
diff --git a/Network/Wai/Handler/Warp/Some.hs b/Network/Wai/Handler/Warp/Some.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Handler/Warp/Some.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Network.Wai.Handler.Warp.Some (
+    Some
+  , singleton
+  , top
+  , lookupWith
+  , union
+  , toList
+  , prune
+  ) where
+
+----------------------------------------------------------------
+
+-- | One ore more list to implement multimap.
+data Some a = One !a
+            | Tom !a !(Some a) -- Two or more
+            deriving (Eq,Show)
+
+{-# INLINE singleton #-}
+singleton :: a -> Some a
+singleton x = One x
+
+{-# INLINE top #-}
+top :: Some a -> a
+top (One x)   = x
+top (Tom x _) = x
+
+{-# INLINE lookupWith #-}
+lookupWith :: (a -> Bool) -> Some a -> Maybe a
+lookupWith f s = go s
+  where
+    go (One x)
+      | f x       = Just x
+      | otherwise = Nothing
+    go (Tom x xs)
+      | f x       = Just x
+      | otherwise = go xs
+
+{-# INLINE union #-}
+union :: Some a -> Some a -> Some a
+union s t = go s t
+  where
+    go (One x)    u = Tom x u
+    go (Tom x xs) u = go xs (Tom x u)
+
+{-# INLINE toList #-}
+toList :: Some a -> [a]
+toList s = go s []
+  where
+    go (One x)    !acc = x : acc
+    go (Tom x xs) !acc = go xs (x : acc)
+
+{-# INLINE prune #-}
+prune :: (a -> IO Bool) -> Some a -> IO (Maybe (Some a))
+prune act s = go s
+  where
+    go (One x) = do
+        keep <- act x
+        return $ if keep then
+                     Just (One x)
+                 else
+                     Nothing
+    go (Tom x xs) = do
+        keep <- act x
+        mys <- go xs
+        return $ if keep then
+                     case mys of
+                         Nothing -> Just (One x)
+                         Just ys -> Just (Tom x ys)
+                 else
+                     mys
+
diff --git a/Network/Wai/Handler/Warp/Types.hs b/Network/Wai/Handler/Warp/Types.hs
--- a/Network/Wai/Handler/Warp/Types.hs
+++ b/Network/Wai/Handler/Warp/Types.hs
@@ -15,10 +15,7 @@
 import qualified Network.Wai.Handler.Warp.FdCache as F
 import qualified Network.Wai.Handler.Warp.FileInfoCache as I
 import qualified Network.Wai.Handler.Warp.Timeout as T
-
-#ifndef WINDOWS
 import System.Posix.Types (Fd)
-#endif
 
 ----------------------------------------------------------------
 
@@ -55,10 +52,6 @@
 
 ----------------------------------------------------------------
 
-#ifdef WINDOWS
-type Fd = ()
-#endif
-
 -- | Data type to abstract file identifiers.
 --   On Unix, a file descriptor would be specified to make use of
 --   the file descriptor cache.
@@ -116,15 +109,39 @@
 
 type Hash = Int
 
--- | Internal information.
+
+data InternalInfo0 =
+    InternalInfo0 T.Manager
+                  (IO D.GMTDate)
+                  (Hash -> FilePath -> IO (Maybe F.Fd, F.Refresh))
+                  (Hash -> FilePath -> IO I.FileInfo)
+
+timeoutManager0 :: InternalInfo0 -> T.Manager
+timeoutManager0 (InternalInfo0 tm _ _ _) = tm
+
+data InternalInfo1 =
+    InternalInfo1 T.Handle
+                  T.Manager
+                  (IO D.GMTDate)
+                  (Hash -> FilePath -> IO (Maybe F.Fd, F.Refresh))
+                  (Hash -> FilePath -> IO I.FileInfo)
+
+toInternalInfo1 :: InternalInfo0 -> T.Handle -> InternalInfo1
+toInternalInfo1 (InternalInfo0 b c d e) a = InternalInfo1 a b c d e
+
+threadHandle1 :: InternalInfo1 -> T.Handle
+threadHandle1 (InternalInfo1 th _ _ _ _) = th
+
 data InternalInfo = InternalInfo {
-    threadHandle :: T.Handle
+    threadHandle   :: T.Handle
   , timeoutManager :: T.Manager
-  , fdCacher :: Maybe F.MutableFdCache
-  , fileInfo :: FilePath -> IO I.FileInfo
-  , fileInfo' :: Int -> FilePath -> IO I.FileInfo
-  , dateCacher :: D.DateCache
+  , getDate        :: IO D.GMTDate
+  , getFd          :: FilePath -> IO (Maybe F.Fd, F.Refresh)
+  , getFileInfo    :: FilePath -> IO I.FileInfo
   }
+
+toInternalInfo :: InternalInfo1 -> Hash -> InternalInfo
+toInternalInfo (InternalInfo1 a b c d e) h = InternalInfo a b c (d h) (e h)
 
 ----------------------------------------------------------------
 
diff --git a/Network/Wai/Handler/Warp/WithApplication.hs b/Network/Wai/Handler/Warp/WithApplication.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Handler/Warp/WithApplication.hs
@@ -0,0 +1,90 @@
+
+module Network.Wai.Handler.Warp.WithApplication (
+  withApplication,
+  testWithApplication,
+  openFreePort,
+  withFreePort,
+) where
+
+import           Control.Concurrent
+import           Control.Concurrent.Async
+import           Control.Exception
+import           Network.Socket
+import           Network.Wai
+import           Network.Wai.Handler.Warp.Run
+import           Network.Wai.Handler.Warp.Settings
+import           Network.Wai.Handler.Warp.Types
+
+-- | Runs the given 'Application' on a free port. Passes the port to the given
+-- operation and executes it, while the 'Application' is running. Shuts down the
+-- server before returning.
+--
+-- @since 3.2.4
+withApplication :: IO Application -> (Port -> IO a) -> IO a
+withApplication mkApp action = do
+  app <- mkApp
+  withFreePort $ \ (port, sock) -> do
+    started <- mkWaiter
+    let settings =
+          defaultSettings{
+            settingsBeforeMainLoop = notify started ()
+          }
+    result <- race
+      (runSettingsSocket settings sock app)
+      (waitFor started >> action port)
+    case result of
+      Left () -> throwIO $ ErrorCall "Unexpected: runSettingsSocket exited"
+      Right x -> return x
+
+-- | Same as 'withApplication' but with different exception handling: If the
+-- given 'Application' throws an exception, 'testWithApplication' will re-throw
+-- the exception to the calling thread, possibly interrupting the execution of
+-- the given operation.
+--
+-- This is handy for running tests against an 'Application' over a real network
+-- port. When running tests, it's useful to let exceptions thrown by your
+-- 'Application' propagate to the main thread of the test-suite.
+--
+-- __The exception handling makes this function unsuitable for use in production.__
+-- Use 'withApplication' instead.
+--
+-- @since 3.2.4
+testWithApplication :: IO Application -> (Port -> IO a) -> IO a
+testWithApplication mkApp action = do
+  callingThread <- myThreadId
+  app <- mkApp
+  let wrappedApp request respond =
+        app request respond `catch` \ e -> do
+          throwTo callingThread (e :: SomeException)
+          throwIO e
+  withApplication (return wrappedApp) action
+
+data Waiter a
+  = Waiter {
+    notify :: a -> IO (),
+    waitFor :: IO a
+  }
+
+mkWaiter :: IO (Waiter a)
+mkWaiter = do
+  mvar <- newEmptyMVar
+  return $ Waiter {
+    notify = putMVar mvar,
+    waitFor = readMVar mvar
+  }
+
+-- | Opens a socket on a free port and returns both port and socket.
+--
+-- @since 3.2.4
+openFreePort :: IO (Port, Socket)
+openFreePort = do
+  s <- socket AF_INET Stream defaultProtocol
+  localhost <- inet_addr "127.0.0.1"
+  bind s (SockAddrInet aNY_PORT localhost)
+  listen s 1
+  port <- socketPort s
+  return (fromIntegral port, s)
+
+-- | Like 'openFreePort' but closes the socket before exiting.
+withFreePort :: ((Port, Socket) -> IO a) -> IO a
+withFreePort = bracket openFreePort (close . snd)
diff --git a/test/FdCacheSpec.hs b/test/FdCacheSpec.hs
--- a/test/FdCacheSpec.hs
+++ b/test/FdCacheSpec.hs
@@ -16,8 +16,8 @@
 spec = describe "withFdCache" $ do
     it "clean up Fd" $ do
         ref <- newIORef (Fd (-1))
-        withFdCache 30000000 $ \(Just mfc) -> do
-            (fd,_) <- getFd mfc "warp.cabal"
+        withFdCache 30000000 $ \getFd -> do
+            (Just fd,_) <- getFd 0 "warp.cabal"
             writeIORef ref fd
         nfd <- readIORef ref
         fdRead nfd 1 `shouldThrow` anyIOException
diff --git a/test/MultiMapSpec.hs b/test/MultiMapSpec.hs
deleted file mode 100644
--- a/test/MultiMapSpec.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-module MultiMapSpec where
-
-import Network.Wai.Handler.Warp.MultiMap
-import Test.Hspec
-import Test.QuickCheck (property)
-
-type Alist = [(Int,Char)]
-
-spec :: Spec
-spec = do
-    describe "fromList" $ do
-        it "generates a valid tree" $ property $ \xs ->
-            valid $ fromList (xs :: Alist)
-    describe "toSortedList" $ do
-        it "generated a sorted list" $ property $ \xs ->
-            ordered $ toSortedList $ fromList (xs :: Alist)
-    describe "search" $ do
-        it "acts as the list model" $ property $ \x xs ->
-            search x (fromList xs) == lookup x (xs :: Alist)
-    describe "fromSortedList" $ do
-        it "generates a valid tree" $ property $ \xs ->
-            valid . fromSortedList . toSortedList . fromList $ (xs :: Alist)
-        it "maintains the tree with toSortedList" $ property $ \xs ->
-            let t1 = fromList (xs :: Alist)
-                t2 = fromSortedList $ toSortedList t1
-            in t1 == t2
-
-ordered :: Ord a => [(a, b)] -> Bool
-ordered (x:y:xys) = fst x <= fst y && ordered (y:xys)
-ordered _         = True
diff --git a/test/WithApplicationSpec.hs b/test/WithApplicationSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/WithApplicationSpec.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module WithApplicationSpec where
+
+import           Control.Concurrent
+import           Control.Exception
+import           Network.HTTP.Types
+import           Network.Socket
+import           Network.Wai
+import           System.IO
+import           System.IO.Silently
+import           System.Process
+import           Test.Hspec
+
+import           Network.Wai.Handler.Warp.WithApplication
+
+spec :: Spec
+spec = do
+  describe "withApplication" $ do
+    it "runs a wai Application while executing the given action" $ do
+      let mkApp = return $ \ _request respond -> respond $ responseLBS ok200 [] "foo"
+      withApplication mkApp $ \ port -> do
+        output <- readProcess "curl" ["-s", "localhost:" ++ show port] ""
+        output `shouldBe` "foo"
+
+    it "does not propagate exceptions from the server to the executing thread" $
+      hSilence [stderr] $ do
+        let mkApp = return $ \ _request _respond -> throwIO $ ErrorCall "foo"
+        withApplication mkApp $ \ port -> do
+          output <- readProcess "curl" ["-s", "localhost:" ++ show port] ""
+          output `shouldContain` "Something went wron"
+
+  describe "testWithApplication" $ do
+    it "propagates exceptions from the server to the executing thread" $
+      hSilence [stderr] $ do
+        let mkApp = return $ \ _request _respond -> throwIO $ ErrorCall "foo"
+        (testWithApplication mkApp $ \ port -> do
+            readProcess "curl" ["-s", "localhost:" ++ show port] "")
+          `shouldThrow` (errorCall "foo")
+
+  describe "withFreePort" $ do
+    it "closes the socket before exiting" $ do
+      MkSocket _ _ _ _ statusMVar <- withFreePort $ \ (_, sock) -> do
+        return sock
+      readMVar statusMVar `shouldReturn` Closed
diff --git a/warp.cabal b/warp.cabal
--- a/warp.cabal
+++ b/warp.cabal
@@ -1,5 +1,5 @@
 Name:                warp
-Version:             3.2.3
+Version:             3.2.4
 Synopsis:            A fast, light-weight web server for WAI applications.
 License:             MIT
 License-file:        LICENSE
@@ -34,6 +34,7 @@
 Library
   Build-Depends:     base                      >= 3        && < 5
                    , array
+                   , async
                    , auto-update               >= 0.1.3    && < 0.2
                    , blaze-builder             >= 0.4
                    , bytestring                >= 0.9.1.4
@@ -90,9 +91,11 @@
                      Network.Wai.Handler.Warp.Run
                      Network.Wai.Handler.Warp.SendFile
                      Network.Wai.Handler.Warp.Settings
+                     Network.Wai.Handler.Warp.Some
                      Network.Wai.Handler.Warp.Timeout
                      Network.Wai.Handler.Warp.Types
                      Network.Wai.Handler.Warp.Windows
+                     Network.Wai.Handler.Warp.WithApplication
                      Paths_warp
   Ghc-Options:       -Wall
 
@@ -122,13 +125,13 @@
                      ExceptionSpec
                      FdCacheSpec
                      FileSpec
-                     MultiMapSpec
                      ReadIntSpec
                      RequestSpec
                      ResponseHeaderSpec
                      ResponseSpec
                      RunSpec
                      SendFileSpec
+                     WithApplicationSpec
                      HTTP
     Hs-Source-Dirs:  test, .
     Type:            exitcode-stdio-1.0
@@ -157,6 +160,7 @@
                    , time
                    , text
                    , streaming-commons         >= 0.1.10
+                   , silently
                    , async
                    , vault
                    , stm                       >= 2.3