diff --git a/warp/LICENSE b/warp/LICENSE
new file mode 100644
index 000000000..482531586
--- /dev/null
+++ b/warp/LICENSE
@@ -0,0 +1,25 @@
+The following license covers this documentation, and the source code, except
+where otherwise indicated.
+
+Copyright 2010, Suite Solutions. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/warp/Network/Wai/Handler/Warp.hs b/warp/Network/Wai/Handler/Warp.hs
new file mode 100755
index 000000000..ed1abb190
--- /dev/null
+++ b/warp/Network/Wai/Handler/Warp.hs
@@ -0,0 +1,576 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+---------------------------------------------------------
+--
+-- Module        : Network.Wai.Handler.Warp
+-- Copyright     : Michael Snoyman
+-- License       : BSD3
+--
+-- Maintainer    : Michael Snoyman <michael@snoyman.com>
+-- Stability     : Stable
+-- Portability   : portable
+--
+-- A fast, light-weight HTTP server handler for WAI.
+--
+---------------------------------------------------------
+
+-- | A fast, light-weight HTTP server handler for WAI. Some random notes (a FAQ, if you will):
+--
+-- * When a 'ResponseFile' indicates a file which does not exist, an exception
+--   is thrown. This will close the connection to the client as well. You should
+--   handle file existance checks at the application level.
+module Network.Wai.Handler.Warp
+    ( -- * Run a Warp server
+      run
+    , runSettings
+    , runSettingsSocket
+      -- * Settings
+    , Settings
+    , defaultSettings
+    , settingsPort
+    , settingsHost
+    , settingsOnException
+    , settingsTimeout
+      -- * Datatypes
+    , Port
+    , InvalidRequest (..)
+      -- * Internal
+    , Manager
+    , withManager
+    , parseRequest
+    , sendResponse
+    , registerKillThread
+    , bindPort
+    , enumSocket
+    , pause
+    , resume
+#if TEST
+    , takeHeaders
+    , readInt
+#endif
+    ) where
+
+import Prelude hiding (catch, lines)
+import Network.Wai
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Unsafe as SU
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as L
+import Network (sClose, Socket)
+import Network.Socket
+    ( accept, Family (..)
+    , SocketType (Stream), listen, bindSocket, setSocketOption, maxListenQueue
+    , SockAddr, SocketOption (ReuseAddr)
+    , AddrInfo(..), AddrInfoFlag(..), defaultHints, getAddrInfo
+    )
+import qualified Network.Socket
+import qualified Network.Socket.ByteString as Sock
+import Control.Exception
+    ( bracket, finally, Exception, SomeException, catch
+    , fromException, AsyncException (ThreadKilled)
+    , bracketOnError
+    )
+import Control.Concurrent (forkIO)
+import qualified Data.Char as C
+import Data.Maybe (fromMaybe)
+
+import Data.Typeable (Typeable)
+
+import Data.Enumerator (($$), (>>==))
+import qualified Data.Enumerator as E
+import qualified Data.Enumerator.List as EL
+import qualified Data.Enumerator.Binary as EB
+import Blaze.ByteString.Builder.Enumerator (builderToByteString)
+import Blaze.ByteString.Builder.HTTP
+    (chunkedTransferEncoding, chunkedTransferTerminator)
+import Blaze.ByteString.Builder
+    (copyByteString, Builder, toLazyByteString, toByteStringIO)
+import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)
+import Data.Monoid (mappend, mconcat)
+import Network.Sendfile
+
+import qualified System.PosixCompat.Files as P
+
+import Control.Monad.IO.Class (liftIO)
+import qualified Timeout as T
+import Timeout (Manager, registerKillThread, pause, resume)
+import Data.Word (Word8)
+import Data.List (foldl')
+import Control.Monad (forever)
+import qualified Network.HTTP.Types as H
+import qualified Data.CaseInsensitive as CI
+import System.IO (hPutStrLn, stderr)
+
+#if WINDOWS
+import Control.Concurrent (threadDelay)
+import qualified Control.Concurrent.MVar as MV
+import Network.Socket (withSocketsDo)
+#endif
+
+bindPort :: Int -> String -> IO Socket
+bindPort p s = do
+    let hints = defaultHints { addrFlags = [AI_PASSIVE
+                                         , AI_NUMERICSERV
+                                         , AI_NUMERICHOST]
+                             , addrSocketType = Stream }
+        host = if s == "*" then Nothing else Just s
+        port = Just . show $ p
+    addrs <- getAddrInfo (Just hints) host port
+    -- Choose an IPv6 socket if exists.  This ensures the socket can
+    -- handle both IPv4 and IPv6 if v6only is false.
+    let addrs' = filter (\x -> addrFamily x == AF_INET6) addrs
+        addr = if null addrs' then head addrs else head addrs'
+    bracketOnError
+        (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
+        (sClose)
+        (\sock -> do
+            setSocketOption sock ReuseAddr 1
+            bindSocket sock (addrAddress addr)
+            listen sock maxListenQueue
+            return sock
+        )
+
+-- | Run an 'Application' on the given port. This calls 'runSettings' with
+-- 'defaultSettings'.
+run :: Port -> Application -> IO ()
+run p = runSettings defaultSettings { settingsPort = p }
+
+-- | Run a Warp server with the given settings.
+runSettings :: Settings -> Application -> IO ()
+#if WINDOWS
+runSettings set app = withSocketsDo $ do
+    var <- MV.newMVar Nothing
+    let clean = MV.modifyMVar_ var $ \s -> maybe (return ()) sClose s >> return Nothing
+    _ <- forkIO $ bracket
+        (bindPort (settingsPort set) (settingsHost set))
+        (const clean)
+        (\s -> do
+            MV.modifyMVar_ var (\_ -> return $ Just s)
+            runSettingsSocket set s app)
+    forever (threadDelay maxBound) `finally` clean
+#else
+runSettings set =
+    bracket
+        (bindPort (settingsPort set) (settingsHost set))
+        sClose .
+        (flip (runSettingsSocket set))
+#endif
+
+type Port = Int
+
+-- | Same as 'runSettings', but uses a user-supplied socket instead of opening
+-- one. This allows the user to provide, for example, Unix named socket, which
+-- can be used when reverse HTTP proxying into your application.
+--
+-- Note that the 'settingsPort' will still be passed to 'Application's via the
+-- 'serverPort' record.
+runSettingsSocket :: Settings -> Socket -> Application -> IO ()
+runSettingsSocket set socket app = do
+    let onE = settingsOnException set
+        port = settingsPort set
+    tm <- T.initialize $ settingsTimeout set * 1000000
+    forever $ do
+        (conn, sa) <- accept socket
+        _ <- forkIO $ do
+            th <- T.registerKillThread tm
+            serveConnection th onE port app conn sa
+            T.cancel th
+        return ()
+
+serveConnection :: T.Handle
+                -> (SomeException -> IO ())
+                -> Port -> Application -> Socket -> SockAddr -> IO ()
+serveConnection th onException port app conn remoteHost' = do
+    catch
+        (finally
+          (E.run_ $ fromClient $$ serveConnection')
+          (sClose conn))
+        onException
+  where
+    fromClient = enumSocket th bytesPerRead conn
+    serveConnection' = do
+        (len, env) <- parseRequest port remoteHost'
+        -- Let the application run for as long as it wants
+        liftIO $ T.pause th
+        res <- E.joinI $ EB.isolate len $$ app env
+        liftIO $ T.resume th
+        keepAlive <- liftIO $ sendResponse th env conn res
+        if keepAlive then serveConnection' else return ()
+
+parseRequest :: Port -> SockAddr -> E.Iteratee S.ByteString IO (Integer, Request)
+parseRequest port remoteHost' = do
+    headers' <- takeHeaders
+    parseRequest' port headers' remoteHost'
+
+-- FIXME come up with good values here
+bytesPerRead, maxTotalHeaderLength :: Int
+bytesPerRead = 4096
+maxTotalHeaderLength = 50 * 1024
+
+data InvalidRequest =
+    NotEnoughLines [String]
+    | BadFirstLine String
+    | NonHttp
+    | IncompleteHeaders
+    | OverLargeHeader
+    deriving (Show, Typeable, Eq)
+instance Exception InvalidRequest
+
+-- | Parse a set of header lines and body into a 'Request'.
+parseRequest' :: Port
+              -> [ByteString]
+              -> SockAddr
+              -> E.Iteratee S.ByteString IO (Integer, Request)
+parseRequest' _ [] _ = E.throwError $ NotEnoughLines []
+parseRequest' port (firstLine:otherLines) remoteHost' = do
+    (method, rpath', gets, httpversion) <- parseFirst firstLine
+    let (host',rpath) =
+            if S.null rpath'
+                then ("","/")
+                else if "http://" `S.isPrefixOf` rpath'
+                         then S.breakByte 47 $ S.drop 7 rpath' -- '/'
+                         else ("", rpath')
+    let heads = map parseHeaderNoAttr otherLines
+    let host = fromMaybe host' $ lookup "host" heads
+    let len =
+            case lookup "content-length" heads of
+                Nothing -> 0
+                Just bs -> fromIntegral $ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0 $ B.takeWhile C.isDigit bs
+    let serverName' = takeUntil 58 host -- ':'
+    -- FIXME isolate takes an Integer instead of Int or Int64. If this is a
+    -- performance penalty, we may need our own version.
+    return (len, Request
+                { requestMethod = method
+                , httpVersion = httpversion
+                , pathInfo = H.decodePathSegments rpath
+                , rawPathInfo = rpath
+                , rawQueryString = gets
+                , queryString = H.parseQuery gets
+                , serverName = serverName'
+                , serverPort = port
+                , requestHeaders = heads
+                , isSecure = False
+                , remoteHost = remoteHost'
+                })
+
+
+takeUntil :: Word8 -> ByteString -> ByteString
+takeUntil c bs =
+    case S.elemIndex c bs of
+       Just !idx -> SU.unsafeTake idx bs
+       Nothing -> bs
+{-# INLINE takeUntil #-}
+
+parseFirst :: ByteString
+           -> E.Iteratee S.ByteString IO (ByteString, ByteString, ByteString, H.HttpVersion)
+parseFirst s = 
+    case S.split 32 s of  -- ' '
+        [method, query, http'] -> do
+            let (hfirst, hsecond) = B.splitAt 5 http'
+            if hfirst == "HTTP/"
+               then let (rpath, qstring) = S.breakByte 63 query  -- '?'
+                        hv =
+                            case hsecond of
+                                "1.1" -> H.http11
+                                _ -> H.http10
+                    in return (method, rpath, qstring, hv)
+               else E.throwError NonHttp
+        _ -> E.throwError $ BadFirstLine $ B.unpack s
+{-# INLINE parseFirst #-} -- FIXME is this inline necessary? the function is only called from one place and not exported
+
+httpBuilder, spaceBuilder, newlineBuilder, transferEncodingBuilder
+           , colonSpaceBuilder :: Builder
+httpBuilder = copyByteString "HTTP/"
+spaceBuilder = fromChar ' '
+newlineBuilder = copyByteString "\r\n"
+transferEncodingBuilder = copyByteString "Transfer-Encoding: chunked\r\n\r\n"
+colonSpaceBuilder = copyByteString ": "
+
+headers :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> Builder
+headers !httpversion !status !responseHeaders !isChunked' = {-# SCC "headers" #-}
+    let !start = httpBuilder
+                `mappend` (copyByteString $
+                            case httpversion of
+                                H.HttpVersion 1 1 -> "1.1"
+                                _ -> "1.0")
+                `mappend` spaceBuilder
+                `mappend` fromShow (H.statusCode status)
+                `mappend` spaceBuilder
+                `mappend` copyByteString (H.statusMessage status)
+                `mappend` newlineBuilder
+        !start' = foldl' responseHeaderToBuilder start responseHeaders
+        !end = if isChunked'
+                 then transferEncodingBuilder
+                 else newlineBuilder
+    in start' `mappend` end
+
+responseHeaderToBuilder :: Builder -> H.Header -> Builder
+responseHeaderToBuilder b (x, y) = b
+  `mappend` copyByteString (CI.original x)
+  `mappend` colonSpaceBuilder
+  `mappend` copyByteString y
+  `mappend` newlineBuilder
+
+checkPersist :: Request -> Bool
+checkPersist req
+    | ver == H.http11 = checkPersist11 conn
+    | otherwise       = checkPersist10 conn
+  where
+    ver = httpVersion req
+    conn = lookup "connection" $ requestHeaders req
+    checkPersist11 (Just x)
+        | CI.foldCase x == "close"      = False
+    checkPersist11 _                    = True
+    checkPersist10 (Just x)
+        | CI.foldCase x == "keep-alive" = True
+    checkPersist10 _                    = False
+
+isChunked :: H.HttpVersion -> Bool
+isChunked = (==) H.http11
+
+hasBody :: H.Status -> Request -> Bool
+hasBody s req = s /= (H.Status 204 "") && requestMethod req /= "HEAD"
+
+sendResponse :: T.Handle
+             -> Request -> Socket -> Response -> IO Bool
+sendResponse th req socket (ResponseFile s hs fp mpart) = do
+    (hs', cl) <-
+        case (readInt `fmap` lookup "content-length" hs, mpart) of
+            (Just cl, _) -> return (hs, cl)
+            (Nothing, Nothing) -> do
+                cl <- P.fileSize `fmap` P.getFileStatus fp
+                return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
+            (Nothing, Just part) -> do
+                let cl = filePartByteCount part
+                return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
+    Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers (httpVersion req) s hs' False
+    let isPersist= checkPersist req
+    if hasBody s req
+        then do
+            case mpart of
+                Nothing   -> sendfile socket fp PartOfFile {
+                    rangeOffset = 0
+                  , rangeLength = cl
+                  } (T.tickle th)
+                Just part -> sendfile socket fp PartOfFile {
+                    rangeOffset = filePartOffset part
+                  , rangeLength = filePartByteCount part
+                  } (T.tickle th)
+            T.tickle th
+            return isPersist
+        else return isPersist
+sendResponse th req socket (ResponseBuilder s hs b)
+    | hasBody s req = do
+          toByteStringIO (\bs -> do
+            Sock.sendAll socket bs
+            T.tickle th) b'
+          return isKeepAlive
+    | otherwise = do
+        Sock.sendMany socket
+            $ L.toChunks
+            $ toLazyByteString
+            $ headers (httpVersion req) s hs False
+        T.tickle th
+        return True
+  where
+    headers' = headers (httpVersion req) s hs isChunked'
+    b' = if isChunked'
+            then headers'
+                 `mappend` chunkedTransferEncoding b
+                 `mappend` chunkedTransferTerminator
+            else headers (httpVersion req) s hs False `mappend` b
+    hasLength = lookup "content-length" hs /= Nothing
+    isChunked' = isChunked (httpVersion req) && not hasLength
+    isPersist = checkPersist req
+    isKeepAlive = isPersist && (isChunked' || hasLength)
+sendResponse th req socket (ResponseEnumerator res) =
+    res go
+  where
+    -- FIXME perhaps alloca a buffer per thread and reuse that in all functiosn below. Should lessen greatly the GC burden (I hope)
+    go s hs | not (hasBody s req) = do
+            liftIO $ Sock.sendMany socket
+                   $ L.toChunks $ toLazyByteString
+                   $ headers (httpVersion req) s hs False
+            return True
+    go s hs = chunk'
+          $ E.enumList 1 [headers (httpVersion req) s hs isChunked']
+         $$ E.joinI $ builderToByteString -- FIXME unsafeBuilderToByteString
+         $$ (iterSocket th socket >> return isKeepAlive)
+      where
+        hasLength = lookup "content-length" hs /= Nothing
+        isChunked' = isChunked (httpVersion req) && not hasLength
+        isPersist = checkPersist req
+        isKeepAlive = isPersist && (isChunked' || hasLength)
+        chunk' i = if isChunked'
+                      then E.joinI $ chunk $$ i
+                      else i
+        chunk :: E.Enumeratee Builder Builder IO Bool
+        chunk = E.checkDone $ E.continue . step
+        step k E.EOF = k (E.Chunks [chunkedTransferTerminator]) >>== return
+        step k (E.Chunks []) = E.continue $ step k
+        step k (E.Chunks [x]) = k (E.Chunks [chunkedTransferEncoding x]) >>== chunk
+        step k (E.Chunks xs) = k (E.Chunks [chunkedTransferEncoding $ mconcat xs]) >>== chunk
+
+parseHeaderNoAttr :: ByteString -> H.Header
+parseHeaderNoAttr s =
+    let (k, rest) = S.breakByte 58 s -- ':'
+        restLen = S.length rest
+        -- FIXME check for colon without following space?
+        rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": "
+                   then SU.unsafeDrop 2 rest
+                   else rest
+     in (CI.mk k, rest')
+
+enumSocket :: T.Handle -> Int -> Socket -> E.Enumerator ByteString IO a
+enumSocket th len socket =
+    inner
+  where
+    inner (E.Continue k) = do
+        bs <- liftIO $ Sock.recv socket len
+        liftIO $ T.tickle th
+        if S.null bs
+            then E.continue k
+            else k (E.Chunks [bs]) >>== inner
+    inner step = E.returnI step
+------ The functions below are not warp-specific and could be split out into a
+--separate package.
+
+iterSocket :: T.Handle
+           -> Socket
+           -> E.Iteratee B.ByteString IO ()
+iterSocket th sock =
+    E.continue step
+  where
+    -- We pause timeouts before passing control back to user code. This ensures
+    -- that a timeout will only ever be executed when Warp is in control. We
+    -- also make sure to resume the timeout after the completion of user code
+    -- so that we can kill idle connections.
+    step E.EOF = liftIO (T.resume th) >> E.yield () E.EOF
+    step (E.Chunks []) = E.continue step
+    step (E.Chunks xs) = do
+        liftIO $ T.resume th
+        liftIO $ Sock.sendMany sock xs
+        liftIO $ T.pause th
+        E.continue step
+
+-- | Various Warp server settings. This is purposely kept as an abstract data
+-- type so that new settings can be added without breaking backwards
+-- compatibility. In order to create a 'Settings' value, use 'defaultSettings'
+-- and record syntax to modify individual records. For example:
+--
+-- > defaultSettings { settingsTimeout = 20 }
+data Settings = Settings
+    { settingsPort :: Int -- ^ Port to listen on. Default value: 3000
+    , settingsHost :: String -- ^ Host to bind to, or * for all. Default value: *
+    , settingsOnException :: SomeException -> IO () -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.
+    , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
+    }
+
+-- | The default settings for the Warp server. See the individual settings for
+-- the default value.
+defaultSettings :: Settings
+defaultSettings = Settings
+    { settingsPort = 3000
+    , settingsHost = "*"
+    , settingsOnException = \e ->
+        case fromException e of
+            Just x -> go x
+            Nothing ->
+                if go' $ fromException e
+                    then hPutStrLn stderr $ show e
+                    else return ()
+    , settingsTimeout = 30
+    }
+  where
+    go :: InvalidRequest -> IO ()
+    go _ = return ()
+    go' (Just ThreadKilled) = False
+    go' _ = True
+
+takeHeaders :: E.Iteratee ByteString IO [ByteString]
+takeHeaders = do
+  !x <- forceHead
+  takeHeaders' 0 id id x
+
+{-# INLINE takeHeaders #-}
+
+takeHeaders' :: Int
+             -> ([ByteString] -> [ByteString])
+             -> ([ByteString] -> [ByteString])
+             -> ByteString
+             -> E.Iteratee S.ByteString IO [ByteString]
+takeHeaders' !len _ _ _ | len > maxTotalHeaderLength = E.throwError OverLargeHeader
+takeHeaders' !len !lines !prepend !bs = do
+  let !bsLen = {-# SCC "takeHeaders'.bsLen" #-} S.length bs
+      !mnl = {-# SCC "takeHeaders'.mnl" #-} S.elemIndex 10 bs
+  case mnl of
+       -- no newline.  prepend entire bs to next line
+       !Nothing -> {-# SCC "takeHeaders'.noNewline" #-} do
+         let !len' = len + bsLen
+         !more <- forceHead 
+         takeHeaders' len' lines (prepend . (:) bs) more
+       Just !nl -> {-# SCC "takeHeaders'.newline" #-} do
+         let !end = nl 
+             !start = nl + 1
+             !line = {-# SCC "takeHeaders'.line" #-}
+                     if end > 0
+                        -- line data included in this chunk
+                        then S.concat $! prepend [SU.unsafeTake (checkCR bs end) bs]
+                        --then S.concat $! prepend [SU.unsafeTake (end-1) bs]
+                        -- no line data in this chunk (all in prepend, or empty line)
+                        else S.concat $! prepend []
+         if S.null line
+            -- no more headers
+            then {-# SCC "takeHeaders'.noMoreHeaders" #-} do
+              let !lines' = {-# SCC "takeHeaders'.noMoreHeaders.lines'" #-} lines []
+              if start < bsLen
+                 then {-# SCC "takeHeaders'.noMoreHeaders.yield" #-} do
+                   let !rest = {-# SCC "takeHeaders'.noMoreHeaders.yield.rest" #-} SU.unsafeDrop start bs
+                   E.yield lines' $! E.Chunks [rest]
+                 else return lines'
+
+            -- more headers
+            else {-# SCC "takeHeaders'.moreHeaders" #-} do
+              let !len' = len + start 
+                  !lines' = {-# SCC "takeHeaders.lines'" #-} lines . (:) line
+              !more <- {-# SCC "takeHeaders'.more" #-} 
+                       if start < bsLen
+                          then return $! SU.unsafeDrop start bs
+                          else forceHead
+              {-# SCC "takeHeaders'.takeMore" #-} takeHeaders' len' lines' id more
+{-# INLINE takeHeaders' #-}
+
+forceHead :: E.Iteratee ByteString IO ByteString
+forceHead = do
+  !mx <- EL.head
+  case mx of
+       !Nothing -> E.throwError IncompleteHeaders
+       Just !x -> return x
+{-# INLINE forceHead #-}
+
+checkCR :: ByteString -> Int -> Int
+checkCR bs pos = 
+  let !p = pos - 1
+  in if '\r' == B.index bs p
+        then p
+        else pos
+{-# INLINE checkCR #-}
+
+-- Note: This function produces garbage on invalid input. But serving an
+-- invalid content-length is a bad idea, mkay?
+readInt :: S.ByteString -> Integer
+readInt = S.foldl' (\x w -> x * 10 + fromIntegral w - 48) 0
+
+-- | Call the inner function with a timeout manager.
+withManager :: Int -- ^ timeout in microseconds
+            -> (Manager -> IO a)
+            -> IO a
+withManager timeout f = do
+    -- FIXME when stopManager is available, use it
+    man <- T.initialize timeout
+    f man
diff --git a/warp/README b/warp/README
new file mode 100644
index 000000000..e69de29bb
diff --git a/warp/Setup.lhs b/warp/Setup.lhs
new file mode 100755
index 000000000..06e2708f2
--- /dev/null
+++ b/warp/Setup.lhs
@@ -0,0 +1,7 @@
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
diff --git a/warp/Timeout.hs b/warp/Timeout.hs
new file mode 100644
index 000000000..27427ae75
--- /dev/null
+++ b/warp/Timeout.hs
@@ -0,0 +1,66 @@
+module Timeout
+    ( Manager
+    , Handle
+    , initialize
+    , register
+    , registerKillThread
+    , tickle
+    , pause
+    , resume
+    , cancel
+    ) where
+
+import qualified Data.IORef as I
+import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread)
+import Control.Monad (forever)
+import qualified Control.Exception as E
+
+-- FIXME implement stopManager
+
+-- | A timeout manager
+newtype Manager = Manager (I.IORef [Handle])
+data Handle = Handle (IO ()) (I.IORef State)
+data State = Active | Inactive | Paused | Canceled
+
+initialize :: Int -> IO Manager
+initialize timeout = do
+    ref <- I.newIORef []
+    _ <- forkIO $ forever $ do
+        threadDelay timeout
+        ms <- I.atomicModifyIORef ref (\x -> ([], x))
+        ms' <- go ms id
+        I.atomicModifyIORef ref (\x -> (ms' x, ()))
+    return $ Manager ref
+  where
+    go [] front = return front
+    go (m@(Handle onTimeout iactive):rest) front = do
+        state <- I.atomicModifyIORef iactive (\x -> (go' x, x))
+        case state of
+            Inactive -> do
+                onTimeout `E.catch` ignoreAll
+                go rest front
+            Canceled -> go rest front
+            _ -> go rest (front . (:) m)
+    go' Active = Inactive
+    go' x = x
+
+ignoreAll :: E.SomeException -> IO ()
+ignoreAll _ = return ()
+
+register :: Manager -> IO () -> IO Handle
+register (Manager ref) onTimeout = do
+    iactive <- I.newIORef Active
+    let h = Handle onTimeout iactive
+    I.atomicModifyIORef ref (\x -> (h : x, ()))
+    return h
+
+registerKillThread :: Manager -> IO Handle
+registerKillThread m = do
+    tid <- myThreadId
+    register m $ killThread tid
+
+tickle, pause, resume, cancel :: Handle -> IO ()
+tickle (Handle _ iactive) = I.writeIORef iactive Active
+pause (Handle _ iactive) = I.writeIORef iactive Paused
+resume = tickle
+cancel (Handle _ iactive) = I.writeIORef iactive Canceled
diff --git a/warp/bigtable-single.hs b/warp/bigtable-single.hs
new file mode 100644
index 000000000..a834f6cef
--- /dev/null
+++ b/warp/bigtable-single.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai
+import Blaze.ByteString.Builder (Builder, fromByteString)
+import Blaze.ByteString.Builder.Char8 (fromShow)
+import Data.Monoid (mappend)
+import Network.Wai.Handler.Warp (run)
+
+bigtable :: Builder
+bigtable =
+    fromByteString "<table>"
+    `mappend` foldr mappend (fromByteString "</table>") (replicate 2 row)
+  where
+    row = fromByteString "<tr>"
+          `mappend` foldr go (fromByteString "</tr>") [1..2]
+    go i rest = fromByteString "<td>"
+                `mappend` fromShow i
+                `mappend` fromByteString "</td>"
+                `mappend` rest
+
+main = run 3000 app
+
+app _ = return $ ResponseBuilder status200 [("Content-Type", "text/html")] bigtable
diff --git a/warp/bigtable-stream.hs b/warp/bigtable-stream.hs
new file mode 100644
index 000000000..bf9be1982
--- /dev/null
+++ b/warp/bigtable-stream.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai
+import Blaze.ByteString.Builder (Builder, fromByteString)
+import Blaze.ByteString.Builder.Char8 (fromShow)
+import Data.Monoid (mappend)
+import Network.Wai.Handler.Warp (run)
+import Data.Enumerator (enumList, ($$), run_)
+
+bigtable :: [Builder]
+bigtable =
+    fromByteString "<table>"
+    : foldr (:) [fromByteString "</table>"] (replicate 2 row)
+  where
+    row = fromByteString "<tr>"
+          `mappend` foldr go (fromByteString "</tr>") [1..2]
+    go i rest = fromByteString "<td>"
+                `mappend` fromShow i
+                `mappend` fromByteString "</td>"
+                `mappend` rest
+
+main = run 3000 app
+
+app _ = return $ ResponseEnumerator $ \f ->
+    run_ $ enumList 4 bigtable $$ f status200 [("Content-Type", "text/html")]
diff --git a/warp/file-nolen.hs b/warp/file-nolen.hs
new file mode 100644
index 000000000..9b3c081d6
--- /dev/null
+++ b/warp/file-nolen.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Network.HTTP.Types
+
+main = run 3000 $ const $ return $ ResponseFile status200 [("Content-Type", "text/plain")] "test.txt" Nothing
diff --git a/warp/file.hs b/warp/file.hs
new file mode 100644
index 000000000..57734f10a
--- /dev/null
+++ b/warp/file.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Network.HTTP.Types
+
+main = run 3000 $ const $ return $ ResponseFile status200 [("Content-Type", "text/plain"), ("Content-Length", "16")] "test.txt" Nothing
diff --git a/warp/pong.hs b/warp/pong.hs
new file mode 100644
index 000000000..b1a6aa1ac
--- /dev/null
+++ b/warp/pong.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Network.HTTP.Types (status200)
+import Blaze.ByteString.Builder (copyByteString)
+import Data.Monoid
+import Data.Enumerator (run_, enumList, ($$))
+
+main = run 3000 app
+
+app req = return $
+    case rawPathInfo req of
+        "/builder/withlen" -> builderWithLen
+        "/builder/nolen" -> builderNoLen
+        "/enum/withlen" -> enumWithLen
+        "/enum/nolen" -> enumNoLen
+        "/file/withlen" -> fileWithLen
+        "/file/nolen" -> fileNoLen
+        x -> index x
+
+builderWithLen = ResponseBuilder
+    status200
+    [ ("Content-Type", "text/plain")
+    , ("Content-Length", "4")
+    ]
+    $ copyByteString "PONG"
+
+builderNoLen = ResponseBuilder
+    status200
+    [ ("Content-Type", "text/plain")
+    ]
+    $ copyByteString "PONG"
+
+fileWithLen = ResponseFile
+    status200
+    [ ("Content-Type", "text/plain")
+    , ("Content-Length", "4")
+    ]
+    "pong.txt"
+    Nothing
+
+fileNoLen = ResponseFile
+    status200
+    [ ("Content-Type", "text/plain")
+    ]
+    "pong.txt"
+    Nothing
+
+enumWithLen = ResponseEnumerator $ \f ->
+    run_ $ (enumList 1 $ map copyByteString ["P", "O", "NG"]) $$ f
+        status200
+        [ ("Content-Type", "text/plain")
+        , ("Content-Length", "4")
+        ]
+
+enumNoLen = ResponseEnumerator $ \f ->
+    run_ $ (enumList 1 $ map copyByteString ["P", "O", "NG"]) $$ f
+        status200
+        [ ("Content-Type", "text/plain")
+        ]
+
+index p = ResponseBuilder status200 [("Content-Type", "text/html")] $ mconcat $ map copyByteString
+    [ "<p><a href='/builder/withlen'>builder withlen</a></p>\n"
+    , "<p><a href='/builder/nolen'>builder nolen</a></p>\n"
+    , "<p><a href='/enum/withlen'>enum withlen</a></p>\n"
+    , "<p><a href='/enum/nolen'>enum nolen</a></p>\n"
+    , "<p><a href='/file/withlen'>file withlen</a></p>\n"
+    , "<p><a href='/file/nolen'>file nolen</a></p>\n"
+    , p
+    ]
diff --git a/warp/runtests.hs b/warp/runtests.hs
new file mode 100644
index 000000000..6dcf15d3a
--- /dev/null
+++ b/warp/runtests.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+import Test.Framework (defaultMain, testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2
+import Test.HUnit hiding (Test)
+
+import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..), readInt)
+import Data.Enumerator (run_, ($$), enumList, run)
+import Control.Exception (fromException)
+import qualified Data.ByteString.Char8 as S8
+
+main :: IO ()
+main = defaultMain [testSuite]
+
+testSuite :: Test
+testSuite = testGroup "Text.Hamlet"
+    [ testCase "takeUntilBlank safe" caseTakeUntilBlankSafe
+    , testCase "takeUntilBlank too many lines" caseTakeUntilBlankTooMany
+    , testCase "takeUntilBlank too large" caseTakeUntilBlankTooLarge
+    , testProperty "takeInt" $ \i' ->
+        let i = abs i'
+         in i == readInt (S8.pack $ show i)
+    ]
+
+caseTakeUntilBlankSafe = do
+    x <- run_ $ (enumList 1 ["f", "oo\n", "bar\nbaz\n\r\n"]) $$ takeHeaders
+    x @?= ["foo", "bar", "baz"]
+
+assertException x (Left se) =
+    case fromException se of
+        Just e -> e @?= x
+        Nothing -> assertFailure "Not an exception"
+assertException _ _ = assertFailure "Not an exception"
+
+caseTakeUntilBlankTooMany = do
+    x <- run $ (enumList 1 $ repeat "f\n") $$ takeHeaders
+    assertException OverLargeHeader x
+
+caseTakeUntilBlankTooLarge = do
+    x <- run $ (enumList 1 $ repeat "f") $$ takeHeaders
+    assertException OverLargeHeader x
diff --git a/warp/server-no-keepalive.hs b/warp/server-no-keepalive.hs
new file mode 100644
index 000000000..254dc55ae
--- /dev/null
+++ b/warp/server-no-keepalive.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai.Handler.Warp
+import Control.Exception (bracket)
+import Control.Monad (forever)
+import Network (sClose)
+import Network.Socket (accept)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Enumerator as E
+import qualified Data.Enumerator.Binary as EB
+import Control.Concurrent (forkIO)
+import Network.Wai (responseLBS)
+import Network.HTTP.Types (status200)
+import Data.Enumerator (($$), run_)
+
+app = const $ return $ responseLBS status200 [("Content-type", "text/plain")] "This is not kept alive under any circumtances"
+
+main = withManager 30000000 $ \man -> bracket
+    (bindPort (settingsPort set) (settingsHost set))
+    sClose
+    (\socket -> forever $ do
+        (conn, sa) <- accept socket
+        th <- liftIO $ registerKillThread man
+        _ <- forkIO $ do
+            run_ $ enumSocket th 4096 conn $$ do
+                liftIO $ pause th
+                (len, env) <- parseRequest (settingsPort set) sa
+                liftIO $ resume th
+                res <- E.joinI $ EB.isolate len $$ app env
+                _ <- liftIO $ sendResponse th env conn res
+                liftIO $ sClose conn
+        return ()
+    )
+  where
+    set = defaultSettings
diff --git a/warp/statuses.hs b/warp/statuses.hs
new file mode 100644
index 000000000..11d91ebf6
--- /dev/null
+++ b/warp/statuses.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Data.ByteString.Lazy.Char8 (pack)
+import qualified Data.ByteString.Char8 as S
+
+main = run 3000 app
+
+app req =
+    return $ responseLBS (Status s' s) [("Content-Type", "text/plain")]
+           $ pack $ concat
+        [ "The status code is "
+        , S.unpack s
+        , ". Have a nice day!"
+        ]
+  where
+    s = S.dropWhile (== '/') $ pathInfo req
+    s' = read $ S.unpack s
diff --git a/warp/test.txt b/warp/test.txt
new file mode 100644
index 000000000..484ba93ef
--- /dev/null
+++ b/warp/test.txt
@@ -0,0 +1 @@
+This is a test.
diff --git a/warp/undrained.hs b/warp/undrained.hs
new file mode 100644
index 000000000..d9c2b32b1
--- /dev/null
+++ b/warp/undrained.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Blaze.ByteString.Builder (fromByteString)
+
+main = run 3000 $ const $ return $ responseBuilder
+    status200
+    [("Content-Type", "text/html")]
+    $ fromByteString "<form method='post' enctype='multipart/form-data'><textarea name='foo'></textarea><input type='submit'></form>"
diff --git a/warp/warp.cabal b/warp/warp.cabal
new file mode 100644
index 000000000..0132bdcbd
--- /dev/null
+++ b/warp/warp.cabal
@@ -0,0 +1,42 @@
+Name:                warp
+Version:             0.4.3
+Synopsis:            A fast, light-weight web server for WAI applications.
+License:             BSD3
+License-file:        LICENSE
+Author:              Michael Snoyman, Matt Brown
+Maintainer:          michael@snoyman.com
+Homepage:            http://github.com/snoyberg/warp
+Category:            Web, Yesod
+Build-Type:          Simple
+Cabal-Version:       >=1.6
+Stability:           Stable
+
+flag network-bytestring
+    Default: False
+
+Library
+  Build-Depends:     base                          >= 3        && < 5
+                   , bytestring                    >= 0.9      && < 0.10
+                   , wai                           >= 0.4      && < 0.5
+                   , blaze-builder-enumerator      >= 0.2      && < 0.3
+                   , transformers                  >= 0.2      && < 0.3
+                   , enumerator                    >= 0.4.5    && < 0.5
+                   , blaze-builder                 >= 0.2.1.4  && < 0.4
+                   , simple-sendfile               >= 0.1      && < 0.2
+                   , http-types                    >= 0.6      && < 0.7
+                   , case-insensitive              >= 0.2      && < 0.4
+                   , unix-compat                   >= 0.2      && < 0.3
+  if flag(network-bytestring)
+      build-depends: network               >= 2.2.1   && < 2.2.3
+                   , network-bytestring    >= 0.1.3   && < 0.1.4
+  else
+      build-depends: network               >= 2.3     && < 2.4
+  Exposed-modules:   Network.Wai.Handler.Warp
+  Other-modules:     Timeout
+  ghc-options:       -Wall
+  if os(windows)
+      Cpp-options: -DWINDOWS
+
+source-repository head
+  type:     git
+  location: git://github.com/snoyberg/warp.git