warp 3.4.18 → 3.4.19
raw patch · 14 files changed
+304/−63 lines, 14 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.Wai.Handler.Warp: BadHost :: InvalidRequest
Files
- ChangeLog.md +20/−0
- Network/Wai/Handler/Warp/File.hs +16/−9
- Network/Wai/Handler/Warp/HTTP2.hs +35/−15
- Network/Wai/Handler/Warp/Header.hs +10/−1
- Network/Wai/Handler/Warp/PackInt.hs +14/−2
- Network/Wai/Handler/Warp/Request.hs +14/−0
- Network/Wai/Handler/Warp/RequestHeader.hs +33/−22
- Network/Wai/Handler/Warp/Types.hs +5/−0
- test/FileSpec.hs +26/−0
- test/HTTP2Spec.hs +62/−0
- test/PackIntSpec.hs +6/−0
- test/ResponseSpec.hs +21/−1
- test/RunSpec.hs +40/−12
- warp.cabal +2/−1
ChangeLog.md view
@@ -1,5 +1,25 @@ # ChangeLog for warp +## 3.4.19++* Security: `Host` is validated. A HTTP/1.1 request without one, and any+ request with more than one, is refused: a router reading the first and an+ application reading `requestHeaderHost` could disagree about which host a+ request was for.+* Security: a `Range` which does not begin inside the file is answered 416,+ rather than dropping the connection with no answer at all.+* Security: `packIntegral` counts its digits by division. The `Double`+ logarithm it used was one short from 10^15 up, and the last digit was+ written before the buffer.+* Security: the HTTP/2 connection a GOAWAY for weak TLS ends is no longer+ served afterwards, and that GOAWAY now follows the SETTINGS frame which+ RFC 9113 has a server send first.+* Security: the HTTP/2 `response` continuation is not called a second time+ when an application throws after its response has gone out.+* `InvalidRequest` gains `BadHost`.+* Header field names are validated by a lookup table rather than by a chain+ of range tests.+ ## 3.4.18 * The accept loop is stopped by being told, through the new
Network/Wai/Handler/Warp/File.hs view
@@ -139,21 +139,28 @@ parseRange :: ByteString -> Integer -> RspFileInfo parseRange rng size = case H.parseByteRanges rng of- Nothing -> WithoutBody H.requestedRangeNotSatisfiable416- Just [] -> WithoutBody H.requestedRangeNotSatisfiable416- Just (r : _) ->- let (!beg, !end) = checkRange r size- !len = end - beg + 1+ Just (r : _) | Just (!beg, !end) <- checkRange r size ->+ let !len = end - beg + 1 s = if beg == 0 && end == size - 1 then H.ok200 else H.partialContent206 in WithBody s [] beg len+ _ -> WithoutBody H.requestedRangeNotSatisfiable416 -checkRange :: H.ByteRange -> Integer -> (Integer, Integer)-checkRange (H.ByteRangeFrom beg) size = (beg, size - 1)-checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size - 1) end)-checkRange (H.ByteRangeSuffix count) size = (max 0 (size - count), size - 1)+-- | The first and last byte a range asks for, or 'Nothing' when it asks+-- for nothing the file holds, which RFC 9110 section 14.4 answers with+-- 416.+checkRange :: H.ByteRange -> Integer -> Maybe (Integer, Integer)+checkRange (H.ByteRangeFrom beg) size+ | beg < 0 || beg >= size = Nothing+ | otherwise = Just (beg, size - 1)+checkRange (H.ByteRangeFromTo beg end) size+ | beg < 0 || beg > end || beg >= size = Nothing+ | otherwise = Just (beg, min (size - 1) end)+checkRange (H.ByteRangeSuffix count) size+ | count <= 0 || size <= 0 = Nothing+ | otherwise = Just (max 0 (size - count), size - 1) ----------------------------------------------------------------
Network/Wai/Handler/Warp/HTTP2.hs view
@@ -74,14 +74,21 @@ , H2.confPeerSockAddr = peersa , H2.confReadNTimeout = True }- checkTLS+ ok <- checkTLS setConnHTTP2 conn True- H2.run H2.defaultServerConfig conf $- http2server "Warp HTTP/2" settings ii transport peersa app+ when ok $+ H2.run H2.defaultServerConfig conf $+ http2server "Warp HTTP/2" settings ii transport peersa app where+ -- A GOAWAY ends the connection, so there is nothing left to serve+ -- on it. checkTLS = case transport of- TCP -> return () -- direct- tls -> unless (tls12orLater tls) $ goaway conn H2.InadequateSecurity "Weak TLS"+ TCP -> return True -- direct+ tls+ | tls12orLater tls -> return True+ | otherwise -> do+ goaway conn H2.InadequateSecurity "Weak TLS"+ return False tls12orLater tls = tlsMajorVersion tls == 3 && tlsMinorVersion tls >= 3 -- | Converting WAI application to the server type of http2 library.@@ -111,22 +118,31 @@ I.writeIORef ref $ Just (h2rsp, pps, st) _ <- response h2rsp pps return ResponseReceived- case eResponseReceived of- Right ResponseReceived -> do- Just (h2rsp, pps, st) <- I.readIORef ref+ msent <- I.readIORef ref+ let logSent (h2rsp, pps, st) = do let msiz = fromIntegral <$> H2.responseBodySize h2rsp logResponse req st msiz mapM_ (logPushPromise req) pps+ case eResponseReceived of+ Right ResponseReceived -> case msent of+ Just sent -> logSent sent+ -- Reachable only through Network.Wai.Internal: the+ -- application said it had answered without answering.+ Nothing -> E.throwIO $ userError "no response from the application" Left e | isAsyncException e -> E.throwIO e | otherwise -> do S.settingsOnException settings (Just req) e- let ersp = S.settingsOnExceptionResponse settings e- st = responseStatus ersp- (h2rsp', _, _) <- fromResponse settings ii req ersp- let msiz = fromIntegral <$> H2.responseBodySize h2rsp'- _ <- response h2rsp' []- logResponse req st msiz+ case msent of+ -- The response has gone out, so this exception+ -- cannot replace it, which is what istatus keeps+ -- HTTP/1 from doing.+ Just sent -> logSent sent+ Nothing -> do+ let ersp = S.settingsOnExceptionResponse settings e+ (h2rsp, _, _) <- fromResponse settings ii req ersp+ _ <- response h2rsp []+ logSent (h2rsp, [], responseStatus ersp) return () where toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th transport@@ -164,9 +180,13 @@ handler = throughAsync (return "") -- connClose must not be called here since Run:fork calls it+--+-- The SETTINGS frame is this server's half of the connection preface,+-- which RFC 9113 has it send before anything else, GOAWAY included. goaway :: Connection -> H2.ErrorCode -> ByteString -> IO ()-goaway Connection{..} etype debugmsg = connSendAll bytestream+goaway Connection{..} etype debugmsg = connSendAll $ preface <> bytestream where einfo = H2.encodeInfo id 0+ preface = H2.encodeFrame einfo $ H2.SettingsFrame [] frame = H2.GoAwayFrame 0 etype debugmsg bytestream = H2.encodeFrame einfo frame
Network/Wai/Handler/Warp/Header.hs view
@@ -12,6 +12,7 @@ import qualified Data.ByteString as BS import Data.CaseInsensitive (foldedCase) import Data.List as L (foldl')+import Data.Maybe (isJust) import Network.HTTP.Types import Network.Wai.Handler.Warp.Types@@ -27,6 +28,8 @@ , reqidxConnection :: Maybe HeaderValue , reqidxRange :: Maybe HeaderValue , reqidxHost :: Maybe HeaderValue+ , reqidxHostRepeated :: Bool+ -- ^ Whether more than one @Host@ field line was sent. , reqidxIfModifiedSince :: Maybe HeaderValue , reqidxIfUnmodifiedSince :: Maybe HeaderValue , reqidxIfRange :: Maybe HeaderValue@@ -40,7 +43,12 @@ indexRequestHeader = L.foldl' insert defaultIndexRequestHeader where insert ix (key, val) = case BS.length bs of- 4 | bs == "host" -> ix{reqidxHost = Just val}+ 4+ | bs == "host" ->+ ix+ { reqidxHost = Just val+ , reqidxHostRepeated = isJust (reqidxHost ix)+ } 5 | bs == "range" -> ix{reqidxRange = Just val} 6 | bs == "expect" -> ix{reqidxExpect = Just val} 7 | bs == "referer" -> ix{reqidxReferer = Just val}@@ -79,6 +87,7 @@ , reqidxConnection = Nothing , reqidxRange = Nothing , reqidxHost = Nothing+ , reqidxHostRepeated = False , reqidxIfModifiedSince = Nothing , reqidxIfUnmodifiedSince = Nothing , reqidxIfRange = Nothing
Network/Wai/Handler/Warp/PackInt.hs view
@@ -16,8 +16,10 @@ packIntegral n | n < 0 = error "packIntegral" packIntegral n = unsafeCreate len go0 where- n' = fromIntegral n + 1 :: Double- len = ceiling $ logBase 10 n'+ -- Counted by division: @ceiling (logBase 10 ...)@ in a 'Double' is+ -- one short from 10^15 up, and 'go' then writes its last digit+ -- before the buffer it was given.+ !len = numDigits n go0 p = go n $ p `plusPtr` (len - 1) go :: Integral a => a -> Ptr Word8 -> IO () go i p = do@@ -26,6 +28,16 @@ when (d /= 0) $ go d (p `plusPtr` (-1)) {-# SPECIALIZE packIntegral :: Int -> ByteString #-} {-# SPECIALIZE packIntegral :: Integer -> ByteString #-}++-- | How many digits a non-negative number is written with.+numDigits :: Integral a => a -> Int+numDigits = go 1+ where+ go !acc i = case i `quot` 10 of+ 0 -> acc+ q -> go (acc + 1) q+{-# SPECIALIZE numDigits :: Int -> Int #-}+{-# SPECIALIZE numDigits :: Integer -> Int #-} -- | --
Network/Wai/Handler/Warp/Request.hs view
@@ -81,6 +81,7 @@ let idxhdr = indexRequestHeader hdr expect = reqidxExpect idxhdr handle100Continue = handleExpect conn httpversion expect+ checkHost httpversion idxhdr (rbody, remainingRef, bodyLength) <- bodyAndSource src idxhdr -- body producing function which will produce '100-continue', if needed rbody' <- timeoutBody remainingRef th rbody handle100Continue@@ -137,6 +138,19 @@ data NoKeepAliveRequest = NoKeepAliveRequest deriving (Show) instance Exception NoKeepAliveRequest++----------------------------------------------------------------++-- | Refusing a request whose @Host@ RFC 9112 section 3.2 refuses.+--+-- A proxy routes on the first @Host@ and an application reads+-- 'requestHeaderHost', the last of them: a repeated one is a way to+-- reach a virtual host the proxy would not have routed to.+checkHost :: H.HttpVersion -> IndexedRequestHeader -> IO ()+checkHost httpversion idxhdr+ | reqidxHostRepeated idxhdr = throwIO BadHost+ | httpversion >= H.http11, isNothing (reqidxHost idxhdr) = throwIO BadHost+ | otherwise = return () ----------------------------------------------------------------
Network/Wai/Handler/Warp/RequestHeader.hs view
@@ -7,6 +7,7 @@ import Control.Exception (throwIO) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C8 (unpack)+import qualified Data.ByteString.Unsafe as SU import Data.ByteString.Internal (memchr) import qualified Data.CaseInsensitive as CI import Data.Word8@@ -160,26 +161,36 @@ -- @S.any@ with a two-way lambda does. hasControl bs = S.elem _cr bs || S.elem _nul bs --- | The characters RFC 9110 allows in a header field name.+-- | Whether RFC 9110 allows the character in a header field name.+--+-- One lookup, where a chain of ranges and an 'elem' over fifteen bytes+-- used to be. isTchar :: Word8 -> Bool-isTchar w =- isAsciiUpper w- || isAsciiLower w- || isDigit w- || w- `elem` [ _exclam- , _numbersign- , _dollar- , _percent- , _ampersand- , _quotesingle- , _asterisk- , _plus- , _hyphen- , _period- , _circum- , _underscore- , _grave- , _bar- , _tilde- ]+isTchar w = SU.unsafeIndex tchars (fromIntegral w) == 1++-- | 'isTchar' for every byte there is.+tchars :: ByteString+tchars = S.pack $ map tchar [minBound .. maxBound]+ where+ tchar w+ | isAsciiUpper w || isAsciiLower w || isDigit w = 1+ | w `elem` symbols = 1+ | otherwise = 0+ symbols =+ [ _exclam+ , _numbersign+ , _dollar+ , _percent+ , _ampersand+ , _quotesingle+ , _asterisk+ , _plus+ , _hyphen+ , _period+ , _circum+ , _underscore+ , _grave+ , _bar+ , _tilde+ ]+{-# NOINLINE tchars #-}
Network/Wai/Handler/Warp/Types.hs view
@@ -61,6 +61,10 @@ | -- | A chunked request body that does not keep to the framing -- RFC 9112 gives it. Since 3.4.17 BadChunkedBody+ | -- | No @Host@ in a HTTP\/1.1 request, or more than one, which+ -- a router and this server may read differently.+ -- Since 3.4.19+ BadHost deriving (Eq) instance Show InvalidRequest where@@ -79,6 +83,7 @@ show BadHeaderLine = "Warp: CR or NUL in a header field line" show (BadFieldName n) = "Warp: Invalid header field name: " ++ show n show BadChunkedBody = "Warp: Malformed chunked request body"+ show BadHost = "Warp: Missing or repeated Host" instance E.Exception InvalidRequest
test/FileSpec.hs view
@@ -130,3 +130,29 @@ "gives the entire body and ignores the Range header if the condition isn't met" [("If-Range", farPast), ("Range", "bytes=2-7")] regularBody+ -- A range which asks for nothing the file holds. The first+ -- of these used to be a negative length, which left the+ -- request answered with nothing at all.+ testFileRange+ "returns a 416 for a range which begins past the end"+ [("Range", "bytes=100-")]+ $ WithoutBody status416+ testFileRange+ "returns a 416 for a range which begins at the end"+ [("Range", "bytes=16-")]+ $ WithoutBody status416+ testFileRange+ "returns a 416 for a suffix of no bytes"+ [("Range", "bytes=-0")]+ $ WithoutBody status416+ -- RFC 9110, section 14.1.2: a suffix longer than the file asks+ -- for the whole of it, which is not a range at all and so is a+ -- 200 rather than a 206.+ testFileRange+ "gives the whole file for a suffix longer than it is"+ [("Range", "bytes=-100")]+ regularBody+ testFileRange+ "gives the whole file for a suffix exactly as long as it is"+ [("Range", "bytes=-16")]+ regularBody
+ test/HTTP2Spec.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++module HTTP2Spec (spec) where++import Control.Exception (bracket, throwIO)+import Data.ByteString (ByteString)+import Data.IORef+import Network.HTTP.Types (Status, ok200, status200)+import qualified Network.HTTP2.Client as C+import Network.Socket+import Network.Wai+import Network.Wai.Handler.Warp (+ Port,+ defaultSettings,+ setLogger,+ setOnException,+ withApplicationSettings,+ )+import Test.Hspec++spec :: Spec+spec = describe "http2server" $+ it "keeps the response of an application which throws after it" $ do+ excs <- newIORef (0 :: Int)+ logged <- newIORef []+ let settings =+ setLogger (\_ st _ -> modifyIORef' logged (st :)) $+ setOnException (\_ _ -> modifyIORef' excs (+ 1)) defaultSettings+ withApplicationSettings settings (pure app) $ \port -> do+ get port `shouldReturn` (Just ok200, "hello")+ readIORef excs `shouldReturn` 1+ -- The second response used to go out and be logged, so the+ -- log said 500 where the client had been answered 200.+ readIORef logged `shouldReturn` [ok200]++-- | Answers, then throws. The response has gone out by then, so+-- nothing can replace it.+app :: Application+app _ respond = do+ _ <- respond $ responseLBS status200 [] "hello"+ throwIO $ userError "after the response"++-- | The status and body of one h2c request.+get :: Port -> IO (Maybe Status, ByteString)+get port = withTCP "127.0.0.1" port $ \sock ->+ bracket (C.allocSimpleConfig sock 4096) C.freeSimpleConfig $ \conf ->+ C.run cliconf conf $ \sendRequest _aux ->+ sendRequest (C.requestNoBody "GET" "/" []) $ \rsp -> do+ body <- C.getResponseBodyChunk rsp+ return (C.responseStatus rsp, body)+ where+ cliconf = C.defaultClientConfig{C.authority = "127.0.0.1"}++-- | Connect to a TCP server, run an action, and close the socket afterwards.+withTCP :: HostName -> Port -> (Socket -> IO a) -> IO a+withTCP host port = bracket open close+ where+ open = do+ addr : _ <- getAddrInfo (Just defaultHints{addrSocketType = Stream}) (Just host) (Just (show port))+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ connect sock (addrAddress addr)+ return sock
test/PackIntSpec.hs view
@@ -12,3 +12,9 @@ prop "" $ \(QC.Large n) -> let n' = fromIntegral (abs n :: Int) in packIntegral (n' :: Int) == C8.pack (show n')+ -- Every power of ten from 10^15 up used to be written into a buffer+ -- one byte too small for it.+ it "writes a number of any size" $+ let ns = [10 ^ e + d | e <- [0 .. 40 :: Int], d <- [-1, 0, 1 :: Integer]]+ in map packIntegral (filter (>= 0) ns)+ `shouldBe` map (C8.pack . show) (filter (>= 0) ns)
test/ResponseSpec.hs view
@@ -16,6 +16,22 @@ main :: IO () main = hspec spec +testUnsatisfiable+ :: S.ByteString+ -- ^ range value+ -> Spec+testUnsatisfiable range = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do+ msWrite ms "GET / HTTP/1.0\r\n"+ msWrite ms "Range: bytes="+ msWrite ms range+ msWrite ms "\r\n\r\n"+ threadDelay 10000+ bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024+ head bss `shouldContain` "416"+ where+ app _ = ($ responseFile status200 [] "attic/hex" Nothing)+ title = show range ++ " is not satisfiable"+ testRange :: S.ByteString -- ^ range value@@ -88,7 +104,11 @@ testRange "5-" "56789abcdef" $ Just "5-15/16" testRange "5-8" "5678" $ Just "5-8/16" testRange "-3" "def" $ Just "13-15/16"- testRange "16-" "" $ Just "*/16"+ -- A range which asks for nothing the file holds is 416, not a+ -- 206 of no bytes. "bytes */16" is the 416 form of the header.+ testUnsatisfiable "16-"+ testUnsatisfiable "100-"+ testUnsatisfiable "-0" testRange "-17" "0123456789abcdef" Nothing describe "partial files" $ do
test/RunSpec.hs view
@@ -292,11 +292,11 @@ headers `shouldBe` [] it "no space between colon and value" $ do appWithSocket $ \iheaders ms -> do- let input = "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"+ let input = "GET / HTTP/1.1\r\nHost: foo\r\nfoo:bar\r\n\r\n" msWrite ms input threadDelay 5000 headers <- I.readIORef iheaders- headers `shouldBe` [("foo", "bar")]+ headers `shouldBe` [("Host", "foo"), ("foo", "bar")] it "refuses multiline headers split across writes" $ do appWithSocket $ \iheaders ms -> do msWrite ms "GET / HTTP/1.1\r\nfoo: and\r\n"@@ -318,9 +318,9 @@ withApp defaultSettings app $ withMySocket $ \ms -> do let input = S.concat- [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"+ [ "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: Chunked\r\n\r\n" , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n"- , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"+ , "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: Chunked\r\n\r\n" , "b\r\nHello World\r\n0\r\n\r\n" ] msWrite ms input@@ -344,7 +344,7 @@ let input = concat $ replicate 2 $- ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"]+ ["POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++ replicate 50 "5\r\n12345\r\n" ++ ["0\r\n\r\n"] mapM_ (msWrite ms) input@@ -374,9 +374,9 @@ withApp defaultSettings app $ withMySocket $ \ms -> do let input = S.concat- [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"+ [ "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: Chunked\r\n\r\n" , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n"- , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"+ , "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: Chunked\r\n\r\n" , "b\r\nHello World\r\n0\r\n\r\n" ] mapM_ (msWrite ms . S.singleton) $ S.unpack input@@ -412,7 +412,7 @@ let bs1 = S.replicate 2048 88 bs2 = "This is short" bs = S.append bs1 bs2- msWrite ms "POST / HTTP/1.1\r\n"+ msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\n" msWrite ms "content-length: " msWrite ms $ S8.pack $ show $ S.length bs msWrite ms "\r\n\r\n"@@ -574,7 +574,7 @@ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ()) f $ responseLBS status200 [] "" withApp defaultSettings app $ withMySocket $ \ms -> do- msWrite ms "POST / HTTP/1.1\r\nTransfer-Encoding: chunked \r\n\r\n"+ msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: chunked \r\n\r\n" msWrite ms "b\r\nHello World\r\n0\r\n\r\n" _ <- msRead ms 17 front <- I.readIORef ifront@@ -614,6 +614,34 @@ "refuses an empty field name" ": 36\r\n" + describe "Host" $ do+ -- A proxy routes on the first Host and the application reads the+ -- last, so a request they can read differently is refused rather+ -- than served to whichever host warp happens to pick.+ let send req = do+ ihosts <- I.newIORef id+ let app r f = do+ I.atomicModifyIORef ihosts $ \front ->+ (front . (requestHeaderHost r :), ())+ f $ responseLBS status200 [] ""+ withApp defaultSettings app $ withMySocket $ \ms -> do+ msWrite ms req+ rsp <- msRead ms 17+ hosts <- I.readIORef ihosts+ return (S8.unpack rsp, hosts [])+ it "refuses a HTTP/1.1 request without one" $ do+ (rsp, hosts) <- send "GET /nohost HTTP/1.1\r\n\r\n"+ rsp `shouldContain` "400"+ hosts `shouldBe` []+ it "refuses more than one" $ do+ (rsp, hosts) <- send "GET /dup HTTP/1.1\r\nHost: a\r\nHost: b\r\n\r\n"+ rsp `shouldContain` "400"+ hosts `shouldBe` []+ it "serves a HTTP/1.0 request without one" $ do+ (rsp, hosts) <- send "GET /nohost HTTP/1.0\r\n\r\n"+ rsp `shouldContain` "200"+ hosts `shouldBe` [Nothing]+ describe "malformed chunked bodies" $ do -- The body is what the client says it is up to the empty line -- which ends the trailer section. Each of these used to end the@@ -678,7 +706,7 @@ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ()) f $ responseLBS status200 [] "" withApp defaultSettings app $ withMySocket $ \ms -> do- msWrite ms "POST / HTTP/1.1\r\nTransfer-Encoding: chunked\r\n\r\n"+ msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: chunked\r\n\r\n" forM_ ["1", "2", "\r\n", S.replicate 0x12 65, "\r\n0\r\n\r\n"] $ \piece -> threadDelay 50000 >> msWrite ms piece _ <- msRead ms 17@@ -698,7 +726,7 @@ loop doubleBS = S.concatMap $ \w -> S.pack [w, w] withApp defaultSettings app $ withMySocket $ \ms -> do- msWrite ms "POST / HTTP/1.1\r\n\r\n12345"+ msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\n\r\n12345" timeout 100000 (msRead ms 10) `shouldReturn` Just "1122334455" msWrite ms "67890" timeout 100000 (msRead ms 10) `shouldReturn` Just "6677889900"@@ -731,7 +759,7 @@ loop loop withApp defaultSettings app $ withMySocket $ \ms -> do- msWrite ms "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"+ msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\ntransfer-encoding: chunked\r\n\r\n" threadDelay 10000 msWrite ms "5\r\nhello\r\n0\r\n\r\n" atomically $ do
warp.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: warp-version: 3.4.18+version: 3.4.19 license: MIT license-file: LICENSE maintainer: michael@snoyman.com@@ -189,6 +189,7 @@ FileSpec GracefulShutdownSpec HTTP+ HTTP2Spec PackIntSpec ReadIntSpec RequestSpec