warp 3.2.12 → 3.2.13
raw patch · 10 files changed
+46/−111 lines, 10 filesdep ~http-types
Dependency ranges changed: http-types
Files
- ChangeLog.md +6/−0
- Network/Wai/Handler/Warp/File.hs +5/−51
- Network/Wai/Handler/Warp/HTTP2/File.hs +3/−36
- Network/Wai/Handler/Warp/HTTP2/HPACK.hs +0/−2
- Network/Wai/Handler/Warp/HTTP2/Receiver.hs +10/−4
- Network/Wai/Handler/Warp/Response.hs +0/−10
- Network/Wai/Handler/Warp/Run.hs +16/−2
- test/ExceptionSpec.hs +2/−2
- test/RunSpec.hs +2/−2
- warp.cabal +2/−2
ChangeLog.md view
@@ -1,3 +1,9 @@+## 3.2.13++* Tickling HTTP/2 timer. [624](https://github.com/yesodweb/wai/pull/624)+* Guarantee atomicity of WINDOW_UPDATE increments [622](https://github.com/yesodweb/wai/pull/622)+* Relax HTTP2 headers check [621](https://github.com/yesodweb/wai/pull/621)+ ## 3.2.12 * If an empty string is set by setServerName, the Server header is not included in response headers [#619](https://github.com/yesodweb/wai/issues/619)
Network/Wai/Handler/Warp/File.hs view
@@ -6,13 +6,12 @@ RspFileInfo(..) , conditionalRequest , addContentHeadersForFilePart- , parseByteRanges+ , H.parseByteRanges ) where import Control.Applicative ((<|>)) import Data.Array ((!))-import qualified Data.ByteString as B hiding (pack)-import qualified Data.ByteString.Char8 as B (pack, readInteger)+import qualified Data.ByteString.Char8 as B (pack) import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) import Network.HTTP.Date@@ -24,10 +23,6 @@ import Network.Wai.Handler.Warp.PackInt import Numeric (showInt) -#ifndef MIN_VERSION_http_types-#define MIN_VERSION_http_types(x,y,z) 1-#endif- -- $setup -- >>> import Test.QuickCheck @@ -99,7 +94,7 @@ ---------------------------------------------------------------- parseRange :: ByteString -> Integer -> RspFileInfo-parseRange rng size = case parseByteRanges rng of+parseRange rng size = case H.parseByteRanges rng of Nothing -> WithoutBody H.requestedRangeNotSatisfiable416 Just [] -> WithoutBody H.requestedRangeNotSatisfiable416 Just (r:_) -> let (!beg, !end) = checkRange r size@@ -115,46 +110,12 @@ checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size - 1) end) checkRange (H.ByteRangeSuffix count) size = (max 0 (size - count), size - 1) --- | Parse the value of a Range header into a 'H.ByteRanges'.-parseByteRanges :: B.ByteString -> Maybe H.ByteRanges-parseByteRanges bs1 = do- bs2 <- stripPrefix "bytes=" bs1- (r, bs3) <- range bs2- ranges (r:) bs3- where- range bs2 = do- (i, bs3) <- B.readInteger bs2- if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")- then Just (H.ByteRangeSuffix (negate i), bs3)- else do- bs4 <- stripPrefix "-" bs3- case B.readInteger bs4 of- Just (j, bs5) | j >= i -> Just (H.ByteRangeFromTo i j, bs5)- _ -> Just (H.ByteRangeFrom i, bs4)- ranges front bs3- | B.null bs3 = Just (front [])- | otherwise = do- bs4 <- stripPrefix "," bs3- (r, bs5) <- range bs4- ranges (front . (r:)) bs5-- stripPrefix x y- | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)- | otherwise = Nothing- ---------------------------------------------------------------- -contentRange :: H.HeaderName-#if MIN_VERSION_http_types(0,9,0)-contentRange = H.hContentRange-#else-contentRange = "Content-Range"-#endif- -- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header' -- for the range specified. contentRangeHeader :: Integer -> Integer -> Integer -> H.Header-contentRangeHeader beg end total = (contentRange, range)+contentRangeHeader beg end total = (H.hContentRange, range) where range = B.pack -- building with ShowS@@ -166,13 +127,6 @@ ( '/' : showInt total "") -acceptRange :: H.HeaderName-#if MIN_VERSION_http_types(0,9,0)-acceptRange = H.hAcceptRanges-#else-acceptRange = "Accept-Ranges"-#endif- addContentHeaders :: H.ResponseHeaders -> Integer -> Integer -> Integer -> H.ResponseHeaders addContentHeaders hs off len size | len == size = hs'@@ -180,7 +134,7 @@ in ctrng:hs' where !lengthBS = packIntegral len- !hs' = (H.hContentLength, lengthBS) : (acceptRange,"bytes") : hs+ !hs' = (H.hContentLength, lengthBS) : (H.hAcceptRanges,"bytes") : hs -- | --
Network/Wai/Handler/Warp/HTTP2/File.hs view
@@ -6,12 +6,11 @@ RspFileInfo(..) , conditionalRequest , addContentHeadersForFilePart- , parseByteRanges+ , H.parseByteRanges ) where import Control.Applicative ((<|>))-import qualified Data.ByteString as B hiding (pack)-import qualified Data.ByteString.Char8 as B (pack, readInteger)+import qualified Data.ByteString.Char8 as B (pack) import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) import Network.HTTP.Date@@ -23,10 +22,6 @@ import Network.HPACK import Network.HPACK.Token -#ifndef MIN_VERSION_http_types-#define MIN_VERSION_http_types(x,y,z) 1-#endif- -- $setup -- >>> import Test.QuickCheck @@ -104,7 +99,7 @@ {-# INLINE parseRange #-} parseRange :: ByteString -> Integer -> RspFileInfo-parseRange rng size = case parseByteRanges rng of+parseRange rng size = case H.parseByteRanges rng of Nothing -> WithoutBody H.requestedRangeNotSatisfiable416 Just [] -> WithoutBody H.requestedRangeNotSatisfiable416 Just (r:_) -> let (!beg, !end) = checkRange r size@@ -120,34 +115,6 @@ 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)--{-# INLINE parseByteRanges #-}--- | Parse the value of a Range header into a 'H.ByteRanges'.-parseByteRanges :: B.ByteString -> Maybe H.ByteRanges-parseByteRanges bs1 = do- bs2 <- stripPrefix "bytes=" bs1- (r, bs3) <- range bs2- ranges (r:) bs3- where- range bs2 = do- (i, bs3) <- B.readInteger bs2- if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")- then Just (H.ByteRangeSuffix (negate i), bs3)- else do- bs4 <- stripPrefix "-" bs3- case B.readInteger bs4 of- Just (j, bs5) | j >= i -> Just (H.ByteRangeFromTo i j, bs5)- _ -> Just (H.ByteRangeFrom i, bs4)- ranges front bs3- | B.null bs3 = Just (front [])- | otherwise = do- bs4 <- stripPrefix "," bs3- (r, bs5) <- range bs4- ranges (front . (r:)) bs5-- stripPrefix x y- | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)- | otherwise = Nothing ----------------------------------------------------------------
Network/Wai/Handler/Warp/HTTP2/HPACK.hs view
@@ -93,7 +93,6 @@ | mScheme == Nothing = False | mPath == Nothing = False | mPath == Just "" = False- | mAuthority == Nothing = False | mConnection /= Nothing = False | just mTE (/= "trailers") = False | otherwise = True@@ -102,7 +101,6 @@ mScheme = getHeaderValue tokenScheme reqvt mPath = getHeaderValue tokenPath reqvt mMethod = getHeaderValue tokenMethod reqvt- mAuthority = getHeaderValue tokenAuthority reqvt mConnection = getHeaderValue tokenConnection reqvt mTE = getHeaderValue tokenTE reqvt
Network/Wai/Handler/Warp/HTTP2/Receiver.hs view
@@ -232,9 +232,12 @@ control FrameWindowUpdate header bs Context{connectionWindow} = do WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs- !w <- (n +) <$> atomically (readTVar connectionWindow)+ !w <- atomically $ do+ w0 <- readTVar connectionWindow+ let !w1 = w0 + n+ writeTVar connectionWindow w1+ return w1 when (isWindowOverflow w) $ E.throwIO $ ConnectionError FlowControlError "control window should be less than 2^31"- atomically $ writeTVar connectionWindow w return True control _ _ _ _ =@@ -336,10 +339,13 @@ stream FrameWindowUpdate header@FrameHeader{streamId} bs _ s Stream{streamWindow} = do WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs- !w <- (n +) <$> atomically (readTVar streamWindow)+ !w <- atomically $ do+ w0 <- readTVar streamWindow+ let !w1 = w0 + n+ writeTVar streamWindow w1+ return w1 when (isWindowOverflow w) $ E.throwIO $ StreamError FlowControlError streamId- atomically $ writeTVar streamWindow w return s stream FrameRSTStream header bs ctx _ strm = do
Network/Wai/Handler/Warp/Response.hs view
@@ -18,10 +18,6 @@ #define MIN_VERSION_base(x,y,z) 1 #endif -#ifndef MIN_VERSION_http_types-#define MIN_VERSION_http_types(x,y,z) 1-#endif- import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTerminator) #if __GLASGOW_HASKELL__ < 709 import Control.Applicative@@ -50,9 +46,7 @@ import Data.Version (showVersion) import Data.Word8 (_cr, _lf) import qualified Network.HTTP.Types as H-#if MIN_VERSION_http_types(0,9,0) import qualified Network.HTTP.Types.Header as H-#endif import Network.Wai import Network.Wai.Handler.Warp.Buffer (toBuilderBuffer) import qualified Network.Wai.Handler.Warp.Date as D@@ -411,11 +405,7 @@ ---------------------------------------------------------------- addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders-#if MIN_VERSION_http_types(0,9,0) addTransferEncoding hdrs = (H.hTransferEncoding, "chunked") : hdrs-#else-addTransferEncoding hdrs = ("transfer-encoding", "chunked") : hdrs-#endif addDate :: IO D.GMTDate -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders addDate getdate rspidxhdr hdrs = case rspidxhdr ! fromEnum ResDate of
Network/Wai/Handler/Warp/Run.hs view
@@ -331,12 +331,13 @@ return (True, bs0) else return (False, bs0)+ istatus <- newIORef False if settingsHTTP2Enabled settings && h2 then do- recvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)+ rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)+ let recvN = wrappedRecvN th istatus (settingsSlowlorisSize settings) rawRecvN -- fixme: origAddr http2 conn ii1 origAddr transport settings recvN app else do- istatus <- newIORef False src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings)) writeIORef istatus True leftoverSource src bs@@ -510,6 +511,19 @@ unless (S.null bs) $ do writeIORef istatus True when (S.length bs >= slowlorisSize) $ T.tickle th+ return bs++wrappedRecvN :: T.Handle -> IORef Bool -> Int -> (BufSize -> IO ByteString) -> (BufSize -> IO ByteString)+wrappedRecvN th istatus slowlorisSize readN bufsize = do+ bs <- readN bufsize+ unless (S.null bs) $ do+ writeIORef istatus True+ -- TODO: think about the slowloris protection in HTTP2: current code+ -- might open a slow-loris attack vector. Rather than timing we should+ -- consider limiting the per-client connections assuming that in HTTP2+ -- we should allow only few connections per host (real-world+ -- deployments with large NATs may be trickier).+ when (S.length bs >= slowlorisSize || bufsize <= slowlorisSize) $ T.tickle th return bs -- Copied from: https://github.com/mzero/plush/blob/master/src/Plush/Server/Warp.hs
test/ExceptionSpec.hs view
@@ -14,7 +14,7 @@ import Control.Exception import qualified Data.Streaming.Network as N import Control.Concurrent.Async (withAsync)-import Network.Socket (sClose)+import Network.Socket (close) import HTTP @@ -24,7 +24,7 @@ withTestServer :: (Int -> IO a) -> IO a withTestServer inner = bracket (N.bindRandomPortTCP "127.0.0.1")- (sClose . snd)+ (close . snd) $ \(prt, lsocket) -> do withAsync (runSettingsSocket defaultSettings lsocket testApp) $ \_ -> inner prt
test/RunSpec.hs view
@@ -19,7 +19,7 @@ import Data.Streaming.Network (bindPortTCP, getSocketTCP, safeRecv) import Network (connectTo, PortID (PortNumber)) import Network.HTTP.Types-import Network.Socket (sClose)+import Network.Socket (close) import Network.Socket.ByteString (sendAll) import Network.Wai import Network.Wai.Handler.Warp@@ -84,7 +84,7 @@ case esocket of Left (_ :: IOException) -> RunSpec.getPort Right socket -> do- sClose socket+ close socket return port withApp :: Settings -> Application -> (Int -> IO a) -> IO a
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 3.2.12+Version: 3.2.13 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -43,7 +43,7 @@ , case-insensitive >= 0.2 , containers , ghc-prim- , http-types >= 0.8.5+ , http-types >= 0.9.1 , iproute >= 1.3.1 , http2 >= 1.6 && < 1.7 , simple-sendfile >= 0.2.7 && < 0.3