warp 3.3.21 → 3.3.22
raw patch · 13 files changed
+179/−94 lines, 13 filesdep ~http2
Dependency ranges changed: http2
Files
- ChangeLog.md +7/−0
- Network/Wai/Handler/Warp.hs +7/−0
- Network/Wai/Handler/Warp/Buffer.hs +22/−4
- Network/Wai/Handler/Warp/HTTP2.hs +4/−3
- Network/Wai/Handler/Warp/HTTP2/Types.hs +2/−3
- Network/Wai/Handler/Warp/IO.hs +36/−18
- Network/Wai/Handler/Warp/Internal.hs +2/−0
- Network/Wai/Handler/Warp/Response.hs +22/−19
- Network/Wai/Handler/Warp/Run.hs +14/−7
- Network/Wai/Handler/Warp/Settings.hs +23/−10
- Network/Wai/Handler/Warp/Types.hs +20/−7
- test/RunSpec.hs +17/−20
- warp.cabal +3/−3
ChangeLog.md view
@@ -1,5 +1,12 @@ # ChangeLog for warp +## 3.3.22++* Creating a bigger buffer when the current one is too small to fit the Builder+ [#895](https://github.com/yesodweb/wai/pull/895)+* Using InvalidRequest instead of HTTP2Error+ [#890](https://github.com/yesodweb/wai/pull/890)+ ## 3.3.21 * Support GHC 9.4 [#889](https://github.com/yesodweb/wai/pull/889)
Network/Wai/Handler/Warp.hs view
@@ -76,6 +76,7 @@ , setGracefulCloseTimeout2 , setMaxTotalHeaderLength , setAltSvc+ , setMaxBuilderResponseBufferSize -- ** Getters , getPort , getHost@@ -461,6 +462,12 @@ -- Since 3.3.11 setAltSvc :: ByteString -> Settings -> Settings setAltSvc altsvc settings = settings { settingsAltSvc = Just altsvc }++-- | Set the maximum buffer size for sending `Builder` responses.+--+-- Since 3.3.22+setMaxBuilderResponseBufferSize :: Int -> Settings -> Settings+setMaxBuilderResponseBufferSize maxRspBufSize settings = settings { settingsMaxBuilderResponseBufferSize = maxRspBufSize } -- | Explicitly pause the slowloris timeout. --
Network/Wai/Handler/Warp/Buffer.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE BangPatterns #-} module Network.Wai.Handler.Warp.Buffer (- bufferSize+ createWriteBuffer+ , bufferSize , allocateBuffer , freeBuffer , mallocBS@@ -15,7 +16,7 @@ import qualified Data.ByteString as BS import Data.ByteString.Internal (memcpy) import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)-import Data.IORef (newIORef, readIORef, writeIORef)+import Data.IORef (IORef, newIORef, readIORef, writeIORef) import qualified Data.Streaming.ByteString.Builder.Buffer as B (Buffer (..)) import Foreign.ForeignPtr import Foreign.Marshal.Alloc (mallocBytes, free, finalizerFree)@@ -26,6 +27,20 @@ ---------------------------------------------------------------- +-- | Allocate a buffer of the given size and wrap it in a 'WriteBuffer'+-- containing that size and a finalizer.+createWriteBuffer :: BufSize -> IO WriteBuffer+createWriteBuffer size = do+ bytes <- allocateBuffer size+ return+ WriteBuffer+ { bufBuffer = bytes,+ bufSize = size,+ bufFree = freeBuffer bytes+ }++----------------------------------------------------------------+ -- | The default size of the write buffer: 16384 (2^14 = 1024 * 16). -- This is the maximum size of TLS record. -- This is also the maximum size of HTTP/2 frame payload@@ -90,8 +105,11 @@ -- Utilities -- -toBuilderBuffer :: Buffer -> BufSize -> IO B.Buffer-toBuilderBuffer ptr size = do+toBuilderBuffer :: IORef WriteBuffer -> IO B.Buffer+toBuilderBuffer writeBufferRef = do+ writeBuffer <- readIORef writeBufferRef+ let ptr = bufBuffer writeBuffer+ size = bufSize writeBuffer fptr <- newForeignPtr_ ptr return $ B.Buffer fptr ptr ptr (ptr `plusPtr` size)
Network/Wai/Handler/Warp/HTTP2.hs view
@@ -11,7 +11,7 @@ import qualified UnliftIO import qualified Data.ByteString as BS-import Data.IORef (IORef, newIORef, writeIORef)+import Data.IORef (IORef, newIORef, writeIORef, readIORef) import qualified Data.IORef as I import qualified Network.HTTP2.Frame as H2 import qualified Network.HTTP2.Server as H2@@ -35,6 +35,7 @@ http2 settings ii conn transport app origAddr th bs = do istatus <- newIORef False rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)+ writeBuffer <- readIORef $ connWriteBuffer conn -- This thread becomes the sender in http2 library. -- In the case of event source, one request comes and one -- worker gets busy. But it is likely that the receiver does@@ -45,8 +46,8 @@ let recvN = wrappedRecvN th istatus (S.settingsSlowlorisSize settings) rawRecvN sendBS x = connSendAll conn x >> T.tickle th conf = H2.Config {- confWriteBuffer = connWriteBuffer conn- , confBufferSize = connBufferSize conn+ confWriteBuffer = bufBuffer writeBuffer+ , confBufferSize = bufSize writeBuffer , confSendAll = sendBS , confReadN = recvN , confPositionReadMaker = pReadMaker ii
Network/Wai/Handler/Warp/HTTP2/Types.hs view
@@ -1,12 +1,11 @@-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} module Network.Wai.Handler.Warp.HTTP2.Types where import qualified Data.ByteString as BS import qualified Network.HTTP.Types as H-import Network.HTTP2+import Network.HTTP2.Frame import qualified Network.HTTP2.Server as H2 import Network.Wai.Handler.Warp.Imports
Network/Wai/Handler/Warp/IO.hs view
@@ -3,28 +3,46 @@ module Network.Wai.Handler.Warp.IO where +import Control.Exception (mask_) import Data.ByteString.Builder (Builder)-import Data.ByteString.Builder.Extra (runBuilder, Next(Done, More, Chunk))-+import Data.ByteString.Builder.Extra (Next (Chunk, Done, More), runBuilder)+import Data.IORef (IORef, readIORef, writeIORef) import Network.Wai.Handler.Warp.Buffer import Network.Wai.Handler.Warp.Imports import Network.Wai.Handler.Warp.Types -toBufIOWith :: Buffer -> BufSize -> (ByteString -> IO ()) -> Builder -> IO ()-toBufIOWith buf !size io builder = loop firstWriter+toBufIOWith :: Int -> IORef WriteBuffer -> (ByteString -> IO ()) -> Builder -> IO ()+toBufIOWith maxRspBufSize writeBufferRef io builder = do+ writeBuffer <- readIORef writeBufferRef+ loop writeBuffer firstWriter where firstWriter = runBuilder builder- runIO len = bufferIO buf len io- loop writer = do- (len, signal) <- writer buf size- case signal of- Done -> runIO len- More minSize next- | size < minSize -> error "toBufIOWith: BufferFull: minSize"- | otherwise -> do- runIO len- loop next- Chunk bs next -> do- runIO len- io bs- loop next+ loop writeBuffer writer = do+ let buf = bufBuffer writeBuffer+ size = bufSize writeBuffer+ (len, signal) <- writer buf size+ bufferIO buf len io+ case signal of+ Done -> return ()+ More minSize next+ | size < minSize -> do+ when (minSize > maxRspBufSize) $+ error $ "Sending a Builder response required a buffer of size "+ ++ show minSize ++ " which is bigger than the specified maximum of "+ ++ show maxRspBufSize ++ "!"+ -- The current WriteBuffer is too small to fit the next+ -- batch of bytes from the Builder so we free it and+ -- create a new bigger one. Freeing the current buffer,+ -- creating a new one and writing it to the IORef need+ -- to be performed atomically to prevent both double+ -- frees and missed frees. So we mask async exceptions:+ biggerWriteBuffer <- mask_ $ do+ bufFree writeBuffer+ biggerWriteBuffer <- createWriteBuffer minSize+ writeIORef writeBufferRef biggerWriteBuffer+ return biggerWriteBuffer+ loop biggerWriteBuffer next+ | otherwise -> loop writeBuffer next+ Chunk bs next -> do+ io bs+ loop writeBuffer next
Network/Wai/Handler/Warp/Internal.hs view
@@ -19,6 +19,8 @@ -- ** Buffer , Buffer , BufSize+ , WriteBuffer(..)+ , createWriteBuffer , bufferSize , allocateBuffer , freeBuffer
Network/Wai/Handler/Warp/Response.hs view
@@ -117,20 +117,21 @@ -- and status, the response to HEAD is processed here. -- -- See definition of rsp below for proper body stripping.- (ms, mlen) <- sendRsp conn ii th ver s hs rspidxhdr rsp+ (ms, mlen) <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize rsp case ms of Nothing -> return () Just realStatus -> logger req realStatus mlen T.tickle th return ret else do- _ <- sendRsp conn ii th ver s hs rspidxhdr RspNoBody+ _ <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize RspNoBody logger req s Nothing T.tickle th return isPersist where defServer = settingsServerName settings logger = settingsLogger settings+ maxRspBufSize = settingsMaxBuilderResponseBufferSize settings ver = httpVersion req s = responseStatus response hs0 = sanitizeHeaders $ responseHeaders response@@ -199,12 +200,13 @@ -> H.Status -> H.ResponseHeaders -> IndexedHeader -- Response+ -> Int -- maxBuilderResponseBufferSize -> Rsp -> IO (Maybe H.Status, Maybe Integer) ---------------------------------------------------------------- -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@@ -212,23 +214,22 @@ ---------------------------------------------------------------- -sendRsp conn _ th ver s hs _ (RspBuilder body needsChunked) = do+sendRsp conn _ th ver s hs _ maxRspBufSize (RspBuilder body needsChunked) = do header <- composeHeaderBuilder ver s hs needsChunked let hdrBdy | needsChunked = header <> chunkedTransferEncoding body <> chunkedTransferTerminator | otherwise = header <> body- buffer = connWriteBuffer conn- size = connBufferSize conn- toBufIOWith buffer size (\bs -> connSendAll conn bs >> T.tickle th) hdrBdy+ writeBufferRef = connWriteBuffer conn+ toBufIOWith maxRspBufSize writeBufferRef (\bs -> connSendAll conn bs >> T.tickle th) hdrBdy return (Just s, Nothing) -- fixme: can we tell the actual sent bytes? ---------------------------------------------------------------- -sendRsp conn _ th ver s hs _ (RspStream streamingBody needsChunked) = do+sendRsp conn _ th ver s hs _ _ (RspStream streamingBody needsChunked) = do header <- composeHeaderBuilder ver s hs needsChunked (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy- $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)+ $ toBuilderBuffer $ connWriteBuffer conn let send builder = do popper <- recv builder let loop = do@@ -249,7 +250,7 @@ ---------------------------------------------------------------- -sendRsp conn _ th _ _ _ _ (RspRaw withApp src) = do+sendRsp conn _ th _ _ _ _ _ (RspRaw withApp src) = do withApp recv send return (Nothing, Nothing) where@@ -263,8 +264,8 @@ -- Sophisticated WAI applications. -- We respect s0. s0 MUST be a proper value.-sendRsp conn ii th ver s0 hs0 rspidxhdr (RspFile path (Just part) _ isHead hook) =- sendRspFile2XX conn ii th ver s0 hs rspidxhdr path beg len isHead hook+sendRsp conn ii th ver s0 hs0 rspidxhdr maxRspBufSize (RspFile path (Just part) _ isHead hook) =+ sendRspFile2XX conn ii th ver s0 hs rspidxhdr maxRspBufSize path beg len isHead hook where beg = filePartOffset part len = filePartByteCount part@@ -274,17 +275,17 @@ -- Simple WAI applications. -- Status is ignored-sendRsp conn ii th ver _ hs0 rspidxhdr (RspFile path Nothing reqidxhdr isHead hook) = do+sendRsp conn ii th ver _ hs0 rspidxhdr maxRspBufSize (RspFile path Nothing reqidxhdr isHead hook) = do efinfo <- UnliftIO.tryIO $ getFileInfo ii path case efinfo of Left (_ex :: UnliftIO.IOException) -> #ifdef WARP_DEBUG print _ex >> #endif- sendRspFile404 conn ii th ver hs0 rspidxhdr+ sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize Right finfo -> case conditionalRequest finfo hs0 rspidxhdr reqidxhdr of- WithoutBody s -> sendRsp conn ii th ver s hs0 rspidxhdr RspNoBody- WithBody s hs beg len -> sendRspFile2XX conn ii th ver s hs rspidxhdr path beg len isHead hook+ WithoutBody s -> sendRsp conn ii th ver s hs0 rspidxhdr maxRspBufSize RspNoBody+ WithBody s hs beg len -> sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize path beg len isHead hook ---------------------------------------------------------------- @@ -295,14 +296,15 @@ -> H.Status -> H.ResponseHeaders -> IndexedHeader+ -> Int -> FilePath -> Integer -> Integer -> Bool -> IO () -> IO (Maybe H.Status, Maybe Integer)-sendRspFile2XX conn ii th ver s hs rspidxhdr path beg len isHead hook- | isHead = sendRsp conn ii th ver s hs rspidxhdr RspNoBody+sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize path beg len isHead hook+ | isHead = sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize RspNoBody | otherwise = do lheader <- composeHeader ver s hs (mfd, fresher) <- getFd ii path@@ -317,8 +319,9 @@ -> H.HttpVersion -> H.ResponseHeaders -> IndexedHeader+ -> Int -> IO (Maybe H.Status, Maybe Integer)-sendRspFile404 conn ii th ver hs0 rspidxhdr = sendRsp conn ii th ver s hs rspidxhdr (RspBuilder body True)+sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize = sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize (RspBuilder body True) where s = H.notFound404 hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
Network/Wai/Handler/Warp/Run.hs view
@@ -57,13 +57,13 @@ socketConnection _ s = do #endif bufferPool <- newBufferPool- writeBuf <- allocateBuffer bufferSize- let sendall = sendAll' s+ writeBuffer <- createWriteBuffer bufferSize+ writeBufferRef <- newIORef writeBuffer isH2 <- newIORef False -- HTTP/1.x return Connection { connSendMany = Sock.sendMany s , connSendAll = sendall- , connSendFile = sendFile s writeBuf bufferSize sendall+ , connSendFile = sendfile writeBufferRef #if MIN_VERSION_network(3,1,1) , connClose = do h2 <- readIORef isH2@@ -76,14 +76,19 @@ #else , connClose = close s #endif- , connFree = freeBuffer writeBuf , connRecv = receive s bufferPool , connRecvBuf = receiveBuf s- , connWriteBuffer = writeBuf- , connBufferSize = bufferSize+ , connWriteBuffer = writeBufferRef , connHTTP2 = isH2 } where+ sendfile writeBufferRef fid offset len hook headers = do+ writeBuffer <- readIORef writeBufferRef+ sendFile s (bufBuffer writeBuffer) (bufSize writeBuffer) sendall+ fid offset len hook headers++ sendall = sendAll' s+ sendAll' sock bs = UnliftIO.handleJust (\ e -> if ioeGetErrorType e == ResourceVanished then Just ConnectionClosedByPeer@@ -309,7 +314,9 @@ -- fact that async exceptions are still masked. UnliftIO.bracket mkConn cleanUp (serve unmask) where- cleanUp (conn, _) = connClose conn `UnliftIO.finally` connFree conn+ cleanUp (conn, _) = connClose conn `UnliftIO.finally` do+ writeBuffer <- readIORef $ connWriteBuffer conn+ bufFree writeBuffer -- We need to register a timeout handler for this thread, and -- cancel that handler as soon as we exit.
Network/Wai/Handler/Warp/Settings.hs view
@@ -10,14 +10,12 @@ import UnliftIO (SomeException, fromException) import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Builder as Builder-import Data.ByteString.Lazy (fromStrict) import Data.Streaming.Network (HostPreference) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Version (showVersion) import GHC.IO.Exception (IOErrorType(..), AsyncException (ThreadKilled)) import qualified Network.HTTP.Types as H-import Network.HTTP2.Frame (HTTP2Error (..), ErrorCodeId (..)) import Network.Socket (SockAddr) import Network.Wai import qualified Paths_warp@@ -140,6 +138,20 @@ -- Default: Nothing -- -- Since 3.3.11+ , settingsMaxBuilderResponseBufferSize :: Int+ -- ^ Determines the maxium buffer size when sending `Builder` responses+ -- (See `responseBuilder`).+ --+ -- When sending a builder response warp uses a 16 KiB buffer to write the+ -- builder to. When that buffer is too small to fit the builder warp will+ -- free it and create a new one that will fit the builder.+ --+ -- To protect against allocating too large a buffer warp will error if the+ -- builder requires more than this maximum.+ --+ -- Default: 1049_000_000 = 1 MiB.+ --+ -- Since 3.3.22 } -- | Specify usage of the PROXY protocol.@@ -180,6 +192,7 @@ , settingsGracefulCloseTimeout2 = 2000 , settingsMaxTotalHeaderLength = 50 * 1024 , settingsAltSvc = Nothing+ , settingsMaxBuilderResponseBufferSize = 1049000000 } -- | Apply the logic provided by 'defaultOnException' to determine if an@@ -213,18 +226,18 @@ -- Since 3.2.27 defaultOnExceptionResponse :: SomeException -> Response defaultOnExceptionResponse e+ | Just PayloadTooLarge <-+ fromException e = responseLBS H.status413+ [(H.hContentType, "text/plain; charset=utf-8")]+ "Payload too large"+ | Just RequestHeaderFieldsTooLarge <-+ fromException e = responseLBS H.status431+ [(H.hContentType, "text/plain; charset=utf-8")]+ "Request header fields too large" | Just (_ :: InvalidRequest) <- fromException e = responseLBS H.badRequest400 [(H.hContentType, "text/plain; charset=utf-8")] "Bad Request"- | Just (ConnectionError (UnknownErrorCode 413) t) <-- fromException e = responseLBS H.status413- [(H.hContentType, "text/plain; charset=utf-8")]- (fromStrict t)- | Just (ConnectionError (UnknownErrorCode 431) t) <-- fromException e = responseLBS H.status431- [(H.hContentType, "text/plain; charset=utf-8")]- (fromStrict t) | otherwise = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] "Something went wrong"
Network/Wai/Handler/Warp/Types.hs view
@@ -40,6 +40,8 @@ | ConnectionClosedByPeer | OverLargeHeader | BadProxyHeader String+ | PayloadTooLarge -- ^ Since 3.3.22+ | RequestHeaderFieldsTooLarge -- ^ Since 3.3.22 deriving (Eq, Typeable) instance Show InvalidRequest where@@ -50,6 +52,8 @@ show ConnectionClosedByPeer = "Warp: Client closed connection prematurely" show OverLargeHeader = "Warp: Request headers too large, possible memory attack detected. Closing connection." show (BadProxyHeader s) = "Warp: Invalid PROXY protocol header: " ++ show s+ show RequestHeaderFieldsTooLarge = "Request header fields too large"+ show PayloadTooLarge = "Payload too large" instance UnliftIO.Exception InvalidRequest @@ -90,6 +94,17 @@ -- | Type for buffer type Buffer = Ptr Word8 +-- | A write buffer of a specified size+-- containing bytes and a way to free the buffer.+data WriteBuffer = WriteBuffer {+ bufBuffer :: Buffer+ -- | The size of the write buffer.+ , bufSize :: !BufSize+ -- | Free the allocated buffer. Warp guarantees it will only be+ -- called once, and no other functions will be called after it.+ , bufFree :: IO ()+ }+ -- | Type for buffer size type BufSize = Int @@ -113,18 +128,16 @@ -- called once. Other functions (like 'connRecv') may be called after -- 'connClose' is called. , connClose :: IO ()- -- | Free any buffers allocated. Warp guarantees it will only be- -- called once, and no other functions will be called after it.- , connFree :: IO () -- | The connection receiving function. This returns "" for EOF. , connRecv :: Recv -- | The connection receiving function. This tries to fill the buffer. -- This returns when the buffer is filled or reaches EOF. , connRecvBuf :: RecvBuf- -- | The write buffer.- , connWriteBuffer :: Buffer- -- | The size of the write buffer.- , connBufferSize :: BufSize+ -- | Reference to a write buffer. When during sending of a 'Builder'+ -- response it's detected the current 'WriteBuffer' is too small it will be+ -- freed and a new bigger buffer will be created and written to this+ -- reference.+ , connWriteBuffer :: IORef WriteBuffer -- | Is this connection HTTP/2? , connHTTP2 :: IORef Bool }
test/RunSpec.hs view
@@ -41,7 +41,7 @@ } msWrite :: MySocket -> ByteString -> IO ()-msWrite ms bs = sendAll (msSocket ms) bs+msWrite = sendAll . msSocket msRead :: MySocket -> Int -> IO ByteString msRead (MySocket s ref) expected = do@@ -83,9 +83,9 @@ incr :: MonadIO m => Counter -> m () incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount ->- ((case ecount of+ (case ecount of Left s -> Left s- Right i -> Right $ i + 1), ())+ Right i -> Right $ i + 1, ()) err :: (MonadIO m, Show a) => Counter -> a -> m () err icount msg = liftIO $ I.writeIORef icount $ Left $ show msg@@ -99,14 +99,14 @@ -> err icount ("Invalid hello" :: String, body) | requestMethod req == "GET" && L.fromChunks body /= "" -> err icount ("Invalid GET" :: String, body)- | not $ requestMethod req `elem` ["GET", "POST"]+ | requestMethod req `notElem` ["GET", "POST"] -> err icount ("Invalid request method (readBody)" :: String, requestMethod req) | otherwise -> incr icount f $ responseLBS status200 [] "Read the body" ignoreBody :: CounterApplication ignoreBody icount req f = do- if (requestMethod req `elem` ["GET", "POST"])+ if requestMethod req `elem` ["GET", "POST"] then incr icount else err icount ("Invalid request method" :: String, requestMethod req) f $ responseLBS status200 [] "Ignored the body"@@ -177,7 +177,7 @@ withApp (setOnException onExc defaultSettings) dummyApp $ withMySocket $ \ms -> do msWrite ms input msClose ms -- explicitly- threadDelay 1000+ threadDelay 5000 res <- I.readIORef ref show res `shouldBe` show (Just expected) @@ -206,14 +206,10 @@ [ singlePostHello , singleGet ]- it "chunked body, read" $ runTest 2 readBody $ concat- [ singleChunkedPostHello- , [singleGet]- ]- it "chunked body, ignore" $ runTest 2 ignoreBody $ concat- [ singleChunkedPostHello- , [singleGet]- ]+ it "chunked body, read" $ runTest 2 readBody $+ singleChunkedPostHello ++ [singleGet]+ it "chunked body, ignore" $ runTest 2 ignoreBody $+ singleChunkedPostHello ++ [singleGet] describe "pipelining" $ do it "no body, read" $ runTest 5 readBody [S.concat $ replicate 5 singleGet] it "no body, ignore" $ runTest 5 ignoreBody [S.concat $ replicate 5 singleGet]@@ -239,7 +235,8 @@ 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"+ it "IncompleteHeaders" $+ runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n" describe "special input" $ do it "multiline headers" $ do@@ -252,7 +249,7 @@ [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n" ] msWrite ms input- threadDelay 1000+ threadDelay 5000 headers <- I.readIORef iheaders headers `shouldBe` [ ("foo", "bar baz\tbin")@@ -267,7 +264,7 @@ [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n" ] msWrite ms input- threadDelay 1000+ threadDelay 5000 headers <- I.readIORef iheaders headers `shouldBe` [ ("foo", "bar")@@ -309,7 +306,7 @@ withApp defaultSettings app $ withMySocket $ \ms -> do let input = concat $ replicate 2 $ ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++- (replicate 50 "5\r\n12345\r\n") +++ replicate 50 "5\r\n12345\r\n" ++ ["0\r\n\r\n"] mapM_ (msWrite ms) input atomically $ do@@ -334,7 +331,7 @@ , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n" , "b\r\nHello World\r\n0\r\n\r\n" ]- mapM_ (msWrite ms) $ map S.singleton $ S.unpack input+ mapM_ (msWrite ms . S.singleton) $ S.unpack input atomically $ do count <- readTVar countVar check $ count == 2@@ -346,7 +343,7 @@ it "timeout in request body" $ do ifront <- I.newIORef id let app req f = do- bss <- (consumeBody $ getRequestBodyChunk req) `onException`+ bss <- consumeBody (getRequestBodyChunk req) `onException` liftIO (I.atomicModifyIORef ifront (\front -> (front . ("consume interrupted":), ()))) liftIO $ threadDelay 4000000 `E.catch` \e -> do I.atomicModifyIORef ifront (\front ->
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 3.3.21+Version: 3.3.22 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -48,7 +48,7 @@ , hashable , http-date , http-types >= 0.12- , http2 >= 3.0 && < 3.1+ , http2 >= 3.0 && < 5 , iproute >= 1.3.1 , simple-sendfile >= 0.2.7 && < 0.3 , stm >= 2.3@@ -205,7 +205,7 @@ , http-client , http-date , http-types >= 0.12- , http2 >= 3.0 && < 3.1+ , http2 >= 3.0 && < 5 , iproute >= 1.3.1 , network , process