warp 3.3.10 → 3.3.11
raw patch · 9 files changed
+134/−73 lines, 9 filesdep ~http2
Dependency ranges changed: http2
Files
- ChangeLog.md +8/−0
- Network/Wai/Handler/Warp.hs +8/−0
- Network/Wai/Handler/Warp/HTTP2.hs +55/−35
- Network/Wai/Handler/Warp/HTTP2/Response.hs +2/−1
- Network/Wai/Handler/Warp/Internal.hs +4/−0
- Network/Wai/Handler/Warp/Response.hs +32/−23
- Network/Wai/Handler/Warp/Run.hs +14/−10
- Network/Wai/Handler/Warp/Settings.hs +8/−1
- warp.cabal +3/−3
ChangeLog.md view
@@ -1,3 +1,11 @@+## 3.3.11++* Adding setAltSvc.+ [#801](https://github.com/yesodweb/wai/pull/801)+* Fixing timeout of builder for HTTP/1.1.+ [#800](https://github.com/yesodweb/wai/pull/800)+* `http2server` and `withII` are exported from `Internal` module.+ ## 3.3.10 * Convert ResourceVanished error to ConnectionClosedByPeer exception
Network/Wai/Handler/Warp.hs view
@@ -75,6 +75,7 @@ , setGracefulCloseTimeout1 , setGracefulCloseTimeout2 , setMaxTotalHeaderLength+ , setAltSvc -- ** Getters , getPort , getHost@@ -449,6 +450,13 @@ setMaxTotalHeaderLength :: Int -> Settings -> Settings setMaxTotalHeaderLength maxTotalHeaderLength settings = settings { settingsMaxTotalHeaderLength = maxTotalHeaderLength }+++-- | Setting the header value of Alternative Services (AltSvc:).+--+-- Since 3.3.11+setAltSvc :: ByteString -> Settings -> Settings+setAltSvc altsvc settings = settings { settingsAltSvc = Just altsvc } -- | Explicitly pause the slowloris timeout. --
Network/Wai/Handler/Warp/HTTP2.hs view
@@ -4,7 +4,10 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} -module Network.Wai.Handler.Warp.HTTP2 (http2) where+module Network.Wai.Handler.Warp.HTTP2 (+ http2+ , http2server+ ) where import qualified Data.IORef as I import qualified Control.Exception as E@@ -24,9 +27,17 @@ ---------------------------------------------------------------- -http2 :: Connection -> Transport -> InternalInfo -> SockAddr -> S.Settings -> (BufSize -> IO ByteString) -> (ByteString -> IO ()) -> Application -> IO ()-http2 conn transport ii addr settings readN send app =- H2.run conf http2server+http2 :: S.Settings+ -> InternalInfo+ -> Connection+ -> Transport+ -> SockAddr+ -> (BufSize -> IO ByteString)+ -> (ByteString -> IO ())+ -> Application+ -> IO ()+http2 settings ii conn transport addr readN send app =+ H2.run conf $ http2server settings ii transport addr app where conf = H2.Config { confWriteBuffer = connWriteBuffer conn@@ -36,37 +47,46 @@ , confPositionReadMaker = pReadMaker ii } - http2server h2req aux response = do- req <- toWAIRequest h2req aux- ref <- I.newIORef Nothing- eResponseReceived <- E.try $ app req $ \rsp -> do- let st = responseStatus rsp- h2rsp <- fromResponse settings ii req rsp- pps <- fromPushPromises ii req- 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- let msiz = fromIntegral <$> H2.responseBodySize h2rsp- logResponse req st msiz- mapM_ (logPushPromise req) pps- Left e@(E.SomeException _)- -- killed by the local worker manager- | Just E.ThreadKilled <- E.fromException e -> return ()- -- killed by the local timeout manager- | Just T.TimeoutThread <- E.fromException e -> return ()- | 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- return ()-+-- | Converting WAI application to the server type of http2 library.+--+-- Since 3.3.11+http2server :: S.Settings+ -> InternalInfo+ -> Transport+ -> SockAddr+ -> Application+ -> H2.Server+http2server settings ii transport addr app h2req0 aux0 response = do+ req <- toWAIRequest h2req0 aux0+ ref <- I.newIORef Nothing+ eResponseReceived <- E.try $ app req $ \rsp -> do+ let st = responseStatus rsp+ h2rsp <- fromResponse settings ii req rsp+ pps <- fromPushPromises ii req+ 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+ let msiz = fromIntegral <$> H2.responseBodySize h2rsp+ logResponse req st msiz+ mapM_ (logPushPromise req) pps+ Left e@(E.SomeException _)+ -- killed by the local worker manager+ | Just E.ThreadKilled <- E.fromException e -> return ()+ -- killed by the local timeout manager+ | Just T.TimeoutThread <- E.fromException e -> return ()+ | 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+ return ()+ where toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th transport where !hdr = H2.requestHeaders h2req
Network/Wai/Handler/Warp/HTTP2/Response.hs view
@@ -48,7 +48,8 @@ !isHead = requestMethod req == H.methodHead !reqhdr = requestHeaders req !svr = S.settingsServerName settings- add date server rsphdr = (H.hDate, date) : (H.hServer, server) : rsphdr+ add date server rsphdr = R.addAltSvc settings $+ (H.hDate, date) : (H.hServer, server) : rsphdr -- fixme: not adding svr if already exists ----------------------------------------------------------------
Network/Wai/Handler/Warp/Internal.hs view
@@ -67,6 +67,9 @@ -- * Platform dependent helper functions , setSocketCloseOnExec , windowsThreadBlockHack+ -- * Misc+ , http2server+ , withII ) where import System.TimeManager@@ -75,6 +78,7 @@ import Network.Wai.Handler.Warp.Date import Network.Wai.Handler.Warp.FdCache import Network.Wai.Handler.Warp.FileInfoCache+import Network.Wai.Handler.Warp.HTTP2 import Network.Wai.Handler.Warp.Header import Network.Wai.Handler.Warp.Recv import Network.Wai.Handler.Warp.Request
Network/Wai/Handler/Warp/Response.hs view
@@ -11,6 +11,7 @@ , hasBody , replaceHeader , addServer -- testing+ , addAltSvc ) where import Data.ByteString.Builder.HTTP.Chunked (chunkedTransferEncoding, chunkedTransferTerminator)@@ -108,7 +109,7 @@ -> Response -- ^ HTTP response including status code and response header. -> IO Bool -- ^ Returing True if the connection is persistent. sendResponse settings conn ii th req reqidxhdr src response = do- hs <- addServerAndDate hs0+ hs <- addAltSvc settings <$> addServerAndDate hs0 if hasBody s then do -- The response to HEAD does not have body. -- But to handle the conditional requests defined RFC 7232 and@@ -116,14 +117,14 @@ -- and status, the response to HEAD is processed here. -- -- See definition of rsp below for proper body stripping.- (ms, mlen) <- sendRsp conn ii ver s hs rspidxhdr rsp+ (ms, mlen) <- sendRsp conn ii th ver s hs rspidxhdr rsp case ms of Nothing -> return () Just realStatus -> logger req realStatus mlen T.tickle th return ret else do- _ <- sendRsp conn ii ver s hs rspidxhdr RspNoBody+ _ <- sendRsp conn ii th ver s hs rspidxhdr RspNoBody logger req s Nothing T.tickle th return isPersist@@ -147,8 +148,8 @@ | otherwise -> RspBuilder b needsChunked ResponseStream _ _ fb | isHead -> RspNoBody- | otherwise -> RspStream fb needsChunked th- ResponseRaw raw _ -> RspRaw raw src (T.tickle th)+ | otherwise -> RspStream fb needsChunked+ ResponseRaw raw _ -> RspRaw raw src -- Make sure we don't hang on to 'response' (avoid space leak) !ret = case response of ResponseFile {} -> isPersist@@ -186,13 +187,14 @@ data Rsp = RspNoBody | RspFile FilePath (Maybe FilePart) IndexedHeader Bool (IO ()) | RspBuilder Builder Bool- | RspStream StreamingBody Bool T.Handle- | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) (IO ())+ | RspStream StreamingBody Bool+ | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) ---------------------------------------------------------------- sendRsp :: Connection -> InternalInfo+ -> T.Handle -> H.HttpVersion -> H.Status -> H.ResponseHeaders@@ -202,7 +204,7 @@ ---------------------------------------------------------------- -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@@ -210,7 +212,7 @@ ---------------------------------------------------------------- -sendRsp conn _ ver s hs _ (RspBuilder body needsChunked) = do+sendRsp conn _ th ver s hs _ (RspBuilder body needsChunked) = do header <- composeHeaderBuilder ver s hs needsChunked let hdrBdy | needsChunked = header <> chunkedTransferEncoding body@@ -218,12 +220,12 @@ | otherwise = header <> body buffer = connWriteBuffer conn size = connBufferSize conn- toBufIOWith buffer size (connSendAll conn) hdrBdy+ toBufIOWith buffer size (\bs -> connSendAll conn bs >> T.tickle th) hdrBdy return (Just s, Nothing) -- fixme: can we tell the actual sent bytes? ---------------------------------------------------------------- -sendRsp conn _ ver s hs _ (RspStream streamingBody needsChunked th) = 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)@@ -247,22 +249,22 @@ ---------------------------------------------------------------- -sendRsp conn _ _ _ _ _ (RspRaw withApp src tickle) = do+sendRsp conn _ th _ _ _ _ (RspRaw withApp src) = do withApp recv send return (Nothing, Nothing) where recv = do bs <- src- unless (S.null bs) tickle+ unless (S.null bs) $ T.tickle th return bs- send bs = connSendAll conn bs >> tickle+ send bs = connSendAll conn bs >> T.tickle th ---------------------------------------------------------------- -- Sophisticated WAI applications. -- We respect s0. s0 MUST be a proper value.-sendRsp conn ii ver s0 hs0 rspidxhdr (RspFile path (Just part) _ isHead hook) =- sendRspFile2XX conn ii ver s0 hs rspidxhdr path beg len isHead hook+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 where beg = filePartOffset part len = filePartByteCount part@@ -272,22 +274,23 @@ -- Simple WAI applications. -- Status is ignored-sendRsp conn ii ver _ hs0 rspidxhdr (RspFile path Nothing reqidxhdr isHead hook) = do+sendRsp conn ii th ver _ hs0 rspidxhdr (RspFile path Nothing reqidxhdr isHead hook) = do efinfo <- E.try $ getFileInfo ii path case efinfo of Left (_ex :: E.IOException) -> #ifdef WARP_DEBUG print _ex >> #endif- sendRspFile404 conn ii ver hs0 rspidxhdr+ sendRspFile404 conn ii th ver hs0 rspidxhdr Right finfo -> case conditionalRequest finfo hs0 rspidxhdr reqidxhdr of- WithoutBody s -> sendRsp conn ii ver s hs0 rspidxhdr RspNoBody- WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook+ 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 ---------------------------------------------------------------- sendRspFile2XX :: Connection -> InternalInfo+ -> T.Handle -> H.HttpVersion -> H.Status -> H.ResponseHeaders@@ -298,8 +301,8 @@ -> Bool -> IO () -> IO (Maybe H.Status, Maybe Integer)-sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook- | isHead = sendRsp conn ii ver s hs rspidxhdr RspNoBody+sendRspFile2XX conn ii th ver s hs rspidxhdr path beg len isHead hook+ | isHead = sendRsp conn ii th ver s hs rspidxhdr RspNoBody | otherwise = do lheader <- composeHeader ver s hs (mfd, fresher) <- getFd ii path@@ -310,11 +313,12 @@ sendRspFile404 :: Connection -> InternalInfo+ -> T.Handle -> H.HttpVersion -> H.ResponseHeaders -> IndexedHeader -> IO (Maybe H.Status, Maybe Integer)-sendRspFile404 conn ii ver hs0 rspidxhdr = sendRsp conn ii ver s hs rspidxhdr (RspBuilder body True)+sendRspFile404 conn ii th ver hs0 rspidxhdr = sendRsp conn ii th ver s hs rspidxhdr (RspBuilder body True) where s = H.notFound404 hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0@@ -408,6 +412,11 @@ addServer serverName rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of Nothing -> (H.hServer, serverName) : hdrs _ -> hdrs++addAltSvc :: Settings -> H.ResponseHeaders -> H.ResponseHeaders+addAltSvc settings hs = case settingsAltSvc settings of+ Nothing -> hs+ Just v -> ("Alt-Svc", v) : hs ----------------------------------------------------------------
Network/Wai/Handler/Warp/Run.hs view
@@ -200,16 +200,20 @@ runSettingsConnectionMakerSecure set getConnMaker app = do settingsBeforeMainLoop set counter <- newCounter- withII $ acceptConnection set getConnMaker app counter- where- withII action =- withTimeoutManager $ \tm ->- D.withDateCache $ \dc ->- F.withFdCache fdCacheDurationInSeconds $ \fdc ->- I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do- let ii = InternalInfo tm dc fdc fic- action ii+ withII set $ acceptConnection set getConnMaker app counter +-- | Running an action with internal info.+--+-- Since 3.3.11+withII :: Settings -> (InternalInfo -> IO a) -> IO a+withII set action =+ withTimeoutManager $ \tm ->+ D.withDateCache $ \dc ->+ F.withFdCache fdCacheDurationInSeconds $ \fdc ->+ I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do+ let ii = InternalInfo tm dc fdc fic+ action ii+ where !fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000 !fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000 !timeoutInSeconds = settingsTimeout set * 1000000@@ -362,7 +366,7 @@ -- fixme: origAddr checkTLS setConnHTTP2 conn True- http2 conn transport ii origAddr settings recvN sendBS app+ http2 settings ii conn transport origAddr recvN sendBS app else do src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings)) writeIORef istatus True
Network/Wai/Handler/Warp/Settings.hs view
@@ -130,8 +130,14 @@ -- Since 3.3.5 , settingsMaxTotalHeaderLength :: Int -- ^ Determines the maximum header size that Warp will tolerate when using HTTP/1.x.- -- + -- -- Since 3.3.8+ , settingsAltSvc :: Maybe ByteString+ -- ^ Specify the header value of Alternative Services (AltSvc:).+ --+ -- Default: Nothing+ --+ -- Since 3.3.11 } -- | Specify usage of the PROXY protocol.@@ -171,6 +177,7 @@ , settingsGracefulCloseTimeout1 = 0 , settingsGracefulCloseTimeout2 = 2000 , settingsMaxTotalHeaderLength = 50 * 1024+ , settingsAltSvc = Nothing } -- | Apply the logic provided by 'defaultOnException' to determine if an
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 3.3.10+Version: 3.3.11 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -45,7 +45,7 @@ , hashable , http-date , http-types >= 0.12- , http2 >= 2.0 && < 2.1+ , http2 , iproute >= 1.3.1 , simple-sendfile >= 0.2.7 && < 0.3 , stm >= 2.3@@ -197,7 +197,7 @@ , http-client , http-date , http-types >= 0.12- , http2 >= 2.0 && < 2.1+ , http2 , iproute >= 1.3.1 , lifted-base >= 0.1 , network