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 @@ -48,7 +48,6 @@ , parseRequest , sendResponse , registerKillThread - , bindPort , pause , resume , T.cancel @@ -56,6 +55,7 @@ , T.initialize #if TEST , takeHeaders + , readInt #endif ) where @@ -68,19 +68,11 @@ 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 Network.Socket (accept, SockAddr) import qualified Network.Socket.ByteString as Sock import Control.Exception ( bracket, finally, Exception, SomeException, catch , fromException, AsyncException (ThreadKilled) - , bracketOnError - , IOException , try ) import Control.Concurrent (forkIO) @@ -88,7 +80,7 @@ import Data.Typeable (Typeable) -import Control.Monad.Trans.Resource (ResourceT, runResourceT) +import Data.Conduit (ResourceT, runResourceT) import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import Data.Conduit.Blaze (builderToByteString) @@ -103,7 +95,7 @@ import qualified System.PosixCompat.Files as P -import Control.Monad.IO.Class (liftIO) +import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Timeout as T import Timeout (Manager, registerKillThread, pause, resume) import Data.Word (Word8) @@ -112,9 +104,9 @@ import qualified Network.HTTP.Types as H import qualified Data.CaseInsensitive as CI import System.IO (hPrint, stderr) +import ReadInt (readInt64) import qualified Data.IORef as I -import Data.String (IsString (..)) -import qualified Data.ByteString.Lex.Integral as LI +import Data.Conduit.Network (bindPort, HostPreference (HostIPv4)) #if WINDOWS import Control.Concurrent (threadDelay) @@ -162,47 +154,6 @@ , connRecv = Sock.recv s bytesPerRead } - -bindPort :: Int -> HostPreference -> IO Socket -bindPort p s = do - let hints = defaultHints { addrFlags = [AI_PASSIVE - , AI_NUMERICSERV - , AI_NUMERICHOST] - , addrSocketType = Stream } - host = - case s of - Host s' -> Just s' - _ -> Nothing - 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 addrs4 = filter (\x -> addrFamily x /= AF_INET6) addrs - addrs6 = filter (\x -> addrFamily x == AF_INET6) addrs - addrs' = - case s of - HostIPv4 -> addrs4 ++ addrs6 - HostIPv6 -> addrs6 ++ addrs4 - _ -> addrs - - tryAddrs (addr1:rest@(_:_)) = - catch - (theBody addr1) - (\(_ :: IOException) -> tryAddrs rest) - tryAddrs (addr1:[]) = theBody addr1 - tryAddrs _ = error "bindPort: addrs is empty" - theBody addr = - 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 - ) - tryAddrs addrs' - -- | Run an 'Application' on the given port. This calls 'runSettings' with -- 'defaultSettings'. run :: Port -> Application -> IO () @@ -259,6 +210,65 @@ T.cancel th return () +-- | Contains a @Source@ and a byte count that is still to be read in. +newtype IsolatedBSSource = IsolatedBSSource (I.IORef (Int, C.Source (ResourceT IO) ByteString)) + +-- | Given an @IsolatedBSSource@ provide a @Source@ that only allows up to the +-- specified number of bytes to be passed downstream. All leftovers should be +-- retained within the @Source@. If there are not enough bytes available, +-- throws a @ConnectionClosedByPeer@ exception. +ibsIsolate :: IsolatedBSSource -> C.Source (ResourceT IO) ByteString +ibsIsolate ibs@(IsolatedBSSource ref) = + C.PipeM pull (return ()) + where + pull = do + (count, src) <- liftIO $ I.readIORef ref + if count == 0 + -- No more bytes wanted downstream, so we're done. + then return $ C.Done Nothing () + else do + -- Get the next chunk (if available) and the updated source + (src', mbs) <- src C.$$+ CL.head + + -- If no chunk available, then there aren't enough bytes in the + -- stream. Throw a ConnectionClosedByPeer + bs <- maybe (liftIO $ throwIO ConnectionClosedByPeer) return mbs + + let -- How many of the bytes in this chunk to send downstream + toSend = min count (S.length bs) + -- How many bytes will still remain to be sent downstream + count' = count - toSend + case () of + () + -- The expected count is greater than the size of the + -- chunk we just read. Send the entire chunk + -- downstream, and then loop on this function for the + -- next chunk. + | count' > 0 -> do + liftIO $ I.writeIORef ref (count', src') + return $ C.HaveOutput (ibsIsolate ibs) (return ()) bs + + -- The expected count is the total size of the chunk we + -- just read. Send this chunk downstream, and then + -- terminate the stream. + | count == S.length bs -> do + liftIO $ I.writeIORef ref (count', src') + return $ C.HaveOutput (C.Done Nothing ()) (return ()) bs + + -- Some of the bytes in this chunk should not be sent + -- downstream. Split up the chunk into the sent and + -- not-sent parts, add the not-sent parts onto the new + -- source, and send the rest of the chunk downstream. + | otherwise -> do + let (x, y) = S.splitAt toSend bs + liftIO $ I.writeIORef ref (count', C.HaveOutput src' (return ()) y) + return $ C.HaveOutput (C.Done Nothing ()) (return ()) x + +-- | Extract the underlying @Source@ from an @IsolatedBSSource@, which will not +-- perform any more isolation. +ibsDone :: IsolatedBSSource -> IO (C.Source (ResourceT IO) ByteString) +ibsDone (IsolatedBSSource ref) = fmap snd $ I.readIORef ref + serveConnection :: Settings -> T.Handle -> (SomeException -> IO ()) @@ -272,11 +282,11 @@ where serveConnection' :: ResourceT IO () serveConnection' = do - fromClient <- C.bufferSource $ connSource conn th + let fromClient = connSource conn th serveConnection'' fromClient serveConnection'' fromClient = do - env <- parseRequest conn port remoteHost' fromClient + (env, ibs) <- parseRequest conn port remoteHost' fromClient case settingsIntercept settings env of Nothing -> do -- Let the application run for as long as it wants @@ -284,21 +294,22 @@ res <- app env -- flush the rest of the request body - requestBody env C.$$ CL.sinkNull + ibsIsolate ibs C.$$ CL.sinkNull + fromClient' <- liftIO $ ibsDone ibs liftIO $ T.resume th keepAlive <- sendResponse th env conn res - when keepAlive $ serveConnection'' fromClient + when keepAlive $ serveConnection'' fromClient' Just intercept -> do liftIO $ T.pause th intercept fromClient conn parseRequest :: Connection -> Port -> SockAddr - -> C.BufferedSource IO S.ByteString - -> ResourceT IO Request -parseRequest conn port remoteHost' src = do - headers' <- src C.$$ takeHeaders - parseRequest' conn port headers' remoteHost' src + -> C.Source (ResourceT IO) S.ByteString + -> ResourceT IO (Request, IsolatedBSSource) +parseRequest conn port remoteHost' src1 = do + (src2, headers') <- src1 C.$$+ takeHeaders + parseRequest' conn port headers' remoteHost' src2 -- FIXME come up with good values here bytesPerRead, maxTotalHeaderLength :: Int @@ -310,6 +321,7 @@ | BadFirstLine String | NonHttp | IncompleteHeaders + | ConnectionClosedByPeer | OverLargeHeader deriving (Show, Typeable, Eq) instance Exception InvalidRequest @@ -333,8 +345,8 @@ -> Port -> [ByteString] -> SockAddr - -> C.BufferedSource IO S.ByteString - -> ResourceT IO Request + -> C.Source (ResourceT IO) S.ByteString -- FIXME was buffered + -> ResourceT IO (Request, IsolatedBSSource) parseRequest' _ _ [] _ _ = throwIO $ NotEnoughLines [] parseRequest' conn port (firstLine:otherLines) remoteHost' src = do (method, rpath', gets, httpversion) <- parseFirst firstLine @@ -349,60 +361,12 @@ let len0 = case lookup "content-length" heads of Nothing -> 0 - Just bs -> LI.readDecimal_ bs + Just bs -> readInt bs let serverName' = takeUntil 58 host -- ':' - rbody <- - if len0 == 0 - then return mempty - else do - -- We can't use the standard isolate, as its counter is not - -- kept in a mutable variable. - lenRef <- liftIO $ I.newIORef len0 - let isolate = C.Conduit push close - push bs = do - len <- liftIO $ I.readIORef lenRef - let (a, b) = S.splitAt len bs - len' = len - S.length a - liftIO $ I.writeIORef lenRef len' - return $ if len' == 0 - then C.Finished (if S.null b then Nothing else Just b) (if S.null a then [] else [a]) - else C.Producing isolate [a] - close = return [] - - -- Make sure that we don't connect to the source after the - -- isolate conduit closes. - -- - -- Here's the issue: we fuse our buffered request body with - -- an isolate conduit which ensures no more than X bytes - -- are read. Suppose we read all X bytes, and then we call - -- requestBody again. What happens? - -- - -- Previously, we would try to read one more chunk from the - -- buffered source. This is inherent to conduit: we - -- wouldn't know that the isolate Conduit isn't accepting - -- more data until after we've pushed some data to it. This - -- results in hanging, since there's no data available on - -- the wire. - -- - -- Instead, we add a wrapper that checks if the request - -- body has already been depleted before making that first - -- pull. - -- - -- Possible optimization: do away with the Conduit - -- entirely. However, this may be less efficient overall, - -- as we'd now have to check the BufferedSource status on - -- each call. Worth looking into. - - wrap src' = C.Source - { C.sourcePull = do - len <- liftIO $ I.readIORef lenRef - if len <= 0 - then return C.Closed - else C.sourcePull src' - , C.sourceClose = return () - } - return $ wrap $ src C.$= isolate - return Request + (rbody, ibs) <- liftIO $ do + ibs <- fmap IsolatedBSSource $ I.newIORef (len0, src) + return (ibsIsolate ibs, ibs) + return (Request { requestMethod = method , httpVersion = httpversion , pathInfo = H.decodePathSegments rpath @@ -416,7 +380,7 @@ , remoteHost = remoteHost' , requestBody = rbody , vault = mempty - } + }, ibs) takeUntil :: Word8 -> ByteString -> ByteString @@ -512,7 +476,7 @@ sendResponse' :: Response -> ResourceT IO Bool sendResponse' (ResponseFile s hs fp mpart) = do eres <- - case (LI.readDecimal_ `fmap` lookup "content-length" hs, mpart) of + case (readInt `fmap` lookup "content-length" hs, mpart) of (Just cl, _) -> return $ Right (hs, cl) (Nothing, Nothing) -> liftIO $ try $ do cl <- P.fileSize `fmap` P.getFileStatus fp @@ -570,22 +534,24 @@ T.tickle th return isPersist where - body = fmap (\x -> case x of + body = fmap2 (\x -> case x of C.Flush -> flush C.Chunk builder -> builder) bodyFlush headers' = headers version s hs -- FIXME perhaps alloca a buffer per thread and reuse that in all -- functions below. Should lessen greatly the GC burden (I hope) needsChunked' = needsChunked hs - chunk :: C.Conduit Builder IO Builder - chunk = C.Conduit - { C.conduitPush = push - , C.conduitClose = close - } - conduit = C.Conduit push close - push x = return $ C.Producing conduit [chunkedTransferEncoding x] - close = return [chunkedTransferTerminator] + chunk :: C.Conduit Builder (ResourceT IO) Builder + chunk = C.NeedInput push close + push x = C.HaveOutput chunk (return ()) (chunkedTransferEncoding x) + close = C.HaveOutput (C.Done Nothing ()) (return ()) chunkedTransferTerminator +fmap2 :: Functor m => (o1 -> o2) -> C.Pipe i o1 m r -> C.Pipe i o2 m r +fmap2 f (C.HaveOutput p c o) = C.HaveOutput (fmap2 f p) c (f o) +fmap2 f (C.NeedInput p c) = C.NeedInput (fmap2 f . p) (fmap2 f c) +fmap2 f (C.PipeM mp c) = C.PipeM (fmap (fmap2 f) mp) c +fmap2 _ (C.Done i x) = C.Done i x + parseHeaderNoAttr :: ByteString -> H.Header parseHeaderNoAttr s = let (k, rest) = S.breakByte 58 s -- ':' @@ -596,33 +562,31 @@ else rest in (CI.mk k, rest') -connSource :: Connection -> T.Handle -> C.Source IO ByteString +connSource :: Connection -> T.Handle -> C.Source (ResourceT IO) ByteString connSource Connection { connRecv = recv } th = src where - src = C.Source - { C.sourcePull = do - bs <- liftIO recv - if S.null bs - then return C.Closed - else do - when (S.length bs >= 2048) $ liftIO $ T.tickle th - return (C.Open src bs) - , C.sourceClose = return () - } + src = C.PipeM (do + bs <- liftIO recv + if S.null bs + then return $ C.Done Nothing () + else do + when (S.length bs >= 2048) $ liftIO $ T.tickle th + return (C.HaveOutput src (return ()) bs)) + (return ()) -- | Use 'connSendAll' to send this data while respecting timeout rules. -connSink :: Connection -> T.Handle -> C.Sink B.ByteString IO () +connSink :: Connection -> T.Handle -> C.Sink B.ByteString (ResourceT IO) () connSink Connection { connSendAll = send } th = - C.SinkData push close + sink where + sink = C.NeedInput push close close = liftIO (T.resume th) - push x = do - liftIO $ do - T.resume th - send x - T.pause th - return (C.Processing push close) + push x = C.PipeM (liftIO $ do + T.resume th + send x + T.pause th + return sink) (liftIO $ T.resume th) -- 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 @@ -642,42 +606,10 @@ , settingsHost :: HostPreference -- ^ Default value: HostIPv4 , 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 - , settingsIntercept :: Request -> Maybe (C.BufferedSource IO S.ByteString -> Connection -> ResourceT IO ()) + , settingsIntercept :: Request -> Maybe (C.Source (ResourceT IO) S.ByteString -> Connection -> ResourceT IO ()) , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing' } --- | Which host to bind. --- --- Note: The @IsString@ instance recognizes the following special values: --- --- * @*@ means @HostAny@ --- --- * @*4@ means @HostIPv4@ --- --- * @*6@ means @HostIPv6@ -data HostPreference = - HostAny - | HostIPv4 - | HostIPv6 - | Host String - deriving (Show, Eq, Ord) - -instance IsString HostPreference where - -- The funny code coming up is to get around some irritating warnings from - -- GHC. I should be able to just write: - {- - fromString "*" = HostAny - fromString "*4" = HostIPv4 - fromString "*6" = HostIPv6 - -} - fromString s'@('*':s) = - case s of - [] -> HostAny - ['4'] -> HostIPv4 - ['6'] -> HostIPv6 - _ -> Host s' - fromString s = Host s - -- | The default settings for the Warp server. See the individual settings for -- the default value. defaultSettings :: Settings @@ -708,52 +640,56 @@ BSEndoList -- previously parsed lines BSEndo -- bytestrings to be prepended -takeHeaders :: C.Sink ByteString IO [ByteString] +takeHeaders :: C.Sink ByteString (ResourceT IO) [ByteString] takeHeaders = - C.sinkState (THStatus 0 id id) takeHeadersPush close + C.NeedInput (push (THStatus 0 id id)) close where - close _ = throwIO IncompleteHeaders -{-# INLINE takeHeaders #-} + close = throwIO IncompleteHeaders -takeHeadersPush :: THStatus - -> ByteString - -> ResourceT IO (C.SinkStateResult THStatus ByteString [ByteString]) -takeHeadersPush (THStatus len _ _ ) _ - | len > maxTotalHeaderLength = throwIO OverLargeHeader -takeHeadersPush (THStatus len lines prepend) bs = - case mnl of - -- no newline. prepend entire bs to next line - Nothing -> do - let len' = len + bsLen - return $ C.StateProcessing $ THStatus len' lines (prepend . S.append bs) - Just nl -> do - let end = nl - start = nl + 1 - line = prepend (if end > 0 - then SU.unsafeTake (checkCR bs end) bs - else S.empty) - if S.null line - -- no more headers - then do - let lines' = lines [] - if start < bsLen - then do - let rest = SU.unsafeDrop start bs - return $ C.StateDone (Just rest) lines' - else return $ C.StateDone Nothing lines' - -- more headers - else do - let len' = len + start - lines' = lines . (:) line - if start < bsLen - then do - let more = SU.unsafeDrop start bs - takeHeadersPush (THStatus len' lines' id) more - else return $ C.StateProcessing $ THStatus len' lines' id - where - bsLen = S.length bs - mnl = S.elemIndex 10 bs -{-# INLINE takeHeadersPush #-} + push (THStatus len lines prepend) bs + -- Too many bytes + | len > maxTotalHeaderLength = throwIO OverLargeHeader + | otherwise = + case mnl of + -- No newline find in this chunk. Add it to the prepend, + -- update the length, and continue processing. + Nothing -> + let len' = len + bsLen + prepend' = prepend . S.append bs + status = THStatus len' lines prepend' + in C.NeedInput (push status) close + -- Found a newline at position end. + Just end -> + let start = end + 1 -- start of next chunk + line + -- There were some bytes before the newline, get them + | end > 0 = prepend $ SU.unsafeTake (checkCR bs end) bs + -- No bytes before the newline + | otherwise = prepend S.empty + in if S.null line + -- no more headers + then + let lines' = lines [] + -- leftover + rest = if start < bsLen + then Just (SU.unsafeDrop start bs) + else Nothing + in C.Done rest lines' + -- more headers + else + let len' = len + start + lines' = lines . (line:) + status = THStatus len' lines' id + in if start < bsLen + -- more bytes in this chunk, push again + then let bs' = SU.unsafeDrop start bs + in push status bs' + -- no more bytes in this chunk, ask for more + else C.NeedInput (push status) close + where + bsLen = S.length bs + mnl = S.elemIndex 10 bs +{-# INLINE takeHeaders #-} checkCR :: ByteString -> Int -> Int checkCR bs pos = @@ -762,6 +698,11 @@ then p else pos {-# INLINE checkCR #-} + +readInt :: Integral a => ByteString -> a +readInt bs = fromIntegral $ readInt64 bs +{-# INLINE readInt #-} + -- | Call the inner function with a timeout manager. withManager :: Int -- ^ timeout in microseconds diff --git a/ReadInt.hs b/ReadInt.hs new file mode 100644 --- /dev/null +++ b/ReadInt.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-} + +-- Copyright : Erik de Castro Lopo +-- License : BSD3 + +module ReadInt (readInt64) where + +-- This function lives in its own file because the MagicHash pragma interacts +-- poorly with the CPP pragma. + +import Data.ByteString (ByteString) +import Data.Int (Int64) +import GHC.Prim +import GHC.Types + +import qualified Data.ByteString.Char8 as B +import qualified Data.Char as C + +-- This function is used to parse the Content-Length field of HTTP headers and +-- is a performance hot spot. It should only be replaced with something +-- significantly and provably faster. +-- +-- It needs to be able work correctly on 32 bit CPUs for file sizes > 2G so we +-- use Int64 here and then make a generic 'readInt' that allows conversion to +-- Int and Integer. + +readInt64 :: ByteString -> Int64 +readInt64 bs = + B.foldl' (\i c -> i * 10 + fromIntegral (mhDigitToInt c)) 0 + $ B.takeWhile C.isDigit bs +{- NOINLINE readInt64MH #-} + +data Table = Table !Addr# + +{- NOINLINE mhDigitToInt #-} +mhDigitToInt :: Char -> Int +mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i))) + where + !(Table addr) = table + table :: Table + table = Table + "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ + \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -7,7 +7,7 @@ import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Monad (forM_) -import System.IO (hFlush) +import System.IO (hFlush, hClose) import System.IO.Unsafe (unsafePerformIO) import Data.ByteString (ByteString, hPutStr, hGetSome) import qualified Data.ByteString as S @@ -86,6 +86,29 @@ Left s -> error s Right i -> i @?= expected +dummyApp :: Application +dummyApp _ = return $ responseLBS status200 [] "foo" + +runTerminateTest :: InvalidRequest + -> ByteString + -> IO () +runTerminateTest expected input = do + port <- getPort + ref <- I.newIORef Nothing + tid <- forkIO $ runSettings defaultSettings + { settingsOnException = \e -> I.writeIORef ref $ Just e + , settingsPort = port + } dummyApp + threadDelay 1000 + handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port + hPutStr handle input + hFlush handle + hClose handle + threadDelay 1000 + killThread tid + res <- I.readIORef ref + show res @?= show (Just expected) + singleGet :: ByteString singleGet = "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" @@ -119,3 +142,7 @@ describe "no hanging" $ do it "has body, read" $ runTest 1 readBody $ map S.singleton $ S.unpack singlePostHello it "double connect" $ runTest 1 doubleConnect [singlePostHello] + + describe "connection termination" $ do + it "ConnectionClosedByPeer" $ runTerminateTest ConnectionClosedByPeer "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r\nhello" + it "IncompleteHeaders" $ runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n" diff --git a/warp.cabal b/warp.cabal --- a/warp.cabal +++ b/warp.cabal @@ -1,5 +1,5 @@ Name: warp -Version: 1.1.0.1 +Version: 1.2.0 Synopsis: A fast, light-weight web server for WAI applications. License: BSD3 License-file: LICENSE @@ -17,19 +17,19 @@ Default: False Library - Build-Depends: base >= 3 && < 5 + Build-Depends: base >= 3 && < 5 , bytestring >= 0.9.1.4 && < 0.10 - , wai >= 1.1 && < 1.2 - , transformers >= 0.2.2 && < 0.3 - , conduit >= 0.2 - , blaze-builder-conduit >= 0.2 && < 0.3 + , wai >= 1.2 && < 1.3 + , transformers >= 0.2.2 && < 0.4 + , conduit >= 0.4 && < 0.5 + , network-conduit >= 0.4 && < 0.5 + , blaze-builder-conduit >= 0.4 && < 0.5 , lifted-base >= 0.1 && < 0.2 - , blaze-builder >= 0.2.1.4 && < 0.4 - , simple-sendfile >= 0.1 && < 0.3 - , http-types >= 0.6 && < 0.7 - , case-insensitive >= 0.2 - , unix-compat >= 0.2 - , bytestring-lexing >= 0.4 + , blaze-builder >= 0.2.1.4 && < 0.4 + , simple-sendfile >= 0.1 && < 0.3 + , http-types >= 0.6 && < 0.7 + , case-insensitive >= 0.2 + , unix-compat >= 0.2 , ghc-prim if flag(network-bytestring) build-depends: network >= 2.2.1.5 && < 2.2.3 @@ -38,6 +38,7 @@ build-depends: network >= 2.3 && < 2.4 Exposed-modules: Network.Wai.Handler.Warp Other-modules: Timeout + ReadInt Paths_warp ghc-options: -Wall if os(windows)