warp 1.1.0.1 → 1.2.0
raw patch · 4 files changed
+265/−238 lines, 4 filesdep +network-conduitdep −bytestring-lexingdep ~blaze-builder-conduitdep ~conduitdep ~transformers
Dependencies added: network-conduit
Dependencies removed: bytestring-lexing
Dependency ranges changed: blaze-builder-conduit, conduit, transformers, wai
Files
- Network/Wai/Handler/Warp.hs +166/−225
- ReadInt.hs +58/−0
- test/main.hs +28/−1
- warp.cabal +13/−12
Network/Wai/Handler/Warp.hs view
@@ -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
+ ReadInt.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-}++-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>+-- 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"#+
test/main.hs view
@@ -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"
warp.cabal view
@@ -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)