dda63bc · typeable/wai

git.iko.soy/typeable/wai

defining a logger for HTTP/2 server push.

commitdda63bcbdef9176c8672e2db9a87a1bb9b84db71 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 29 Jun 2016, 13:59 (10 years ago) parent6c837f1

3 files changed+22−6

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp.hs+5 warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+12−6 warp/Network/Wai/Handler/Warp/Settings.hs+5

warp/Network/Wai/Handler/Warp.hs+5

@@ -70,6 +70,7 @@ module Network.Wai.Handler.Warp (

7070 , setSlowlorisSize

7171 , setHTTP2Disabled

7272 , setLogger

73+ , setServerPushLogger

7374 , setGracefulShutdownTimeout

7475 -- ** Getters

7576 , getPort

@@ -372,6 +373,10 @@ setLogger :: (Request -> H.Status -> Maybe Integer -> IO ())

372373 -> Settings -> Settings

373374setLogger lgr y = y { settingsLogger = lgr }

374375

376+setServerPushLogger :: (SockAddr -> ByteString -> Integer -> ByteString -> Maybe ByteString -> IO ())

377+ -> Settings -> Settings

378+setServerPushLogger lgr y = y { settingsServerPushLogger = lgr }

379+

375380-- | Set the graceful shutdown timeout. A timeout of `Nothing' will

376381-- wait indefinitely, and a number, if provided, will be treated as seconds

377382-- to wait for requests to finish, before shutting down the server entirely.

warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+12−6

@@ -53,11 +53,12 @@ type Responder = InternalInfo

5353 -> Response

5454 -> IO ResponseReceived

5555

56−pushStream :: Context -> StreamId -> ValueTable -> InternalInfo

56+pushStream :: Context -> S.Settings

57+ -> StreamId -> ValueTable -> Request -> InternalInfo

5758 -> Maybe HTTP2Data

5859 -> IO (Stream -> Rspn -> InternalInfo -> IO () -> Output, IO ())

59−pushStream _ _ _ _ Nothing = return (ORspn, return ())

60−pushStream ctx@Context{http2settings,outputQ} pid reqvt ii (Just h2d)

60+pushStream _ _ _ _ _ _ Nothing = return (ORspn, return ())

61+pushStream ctx@Context{http2settings,outputQ} settings pid reqvt req ii (Just h2d)

6162 | len == 0 = return (ORspn, return ())

6263 | otherwise = do

6364 pushable <- enablePush <$> readIORef http2settings

@@ -73,6 +74,10 @@ pushStream ctx@Context{http2settings,outputQ} pid reqvt ii (Just h2d)

7374 where

7475 !pps0 = http2dataPushPromise h2d

7576 !len = length pps0

77+ !pushLogger = S.settingsServerPushLogger settings

78+ !sa = remoteHost req

79+ !mua = requestHeaderUserAgent req

80+ !referer = rawPathInfo req

7681 increment tvar = atomically $ modifyTVar' tvar (+1)

7782 waiter lim tvar = atomically $ do

7883 n <- readTVar tvar

@@ -100,6 +105,7 @@ pushStream ctx@Context{http2settings,outputQ} pid reqvt ii (Just h2d)

100105 !rsp = RspnFile H.ok200 (ths,vt) file (Just part)

101106 !ths = (tokenLastModified,date) :

102107 addContentHeadersForFilePart ths0 part

108+ pushLogger sa path size referer mua

103109 let out = OPush strm promisedRequest rsp ii (increment tvar) pid

104110 enqueueOutput outputQ out

105111 push tvar pps (n + 1)

@@ -114,18 +120,18 @@ response settings ctx@Context{outputQ} mgr ii reqvt tconf strm req rsp = case rs

114120 | noBody s0 -> responseNoBody s0 hs0

115121 | isHead -> responseNoBody s0 hs0

116122 | otherwise -> getHTTP2Data req

117− >>= pushStream ctx sid reqvt ii

123+ >>= pushStream ctx settings sid reqvt req ii

118124 >>= responseStreaming s0 hs0 strmbdy

119125 ResponseBuilder s0 hs0 b

120126 | noBody s0 -> responseNoBody s0 hs0

121127 | isHead -> responseNoBody s0 hs0

122128 | otherwise -> getHTTP2Data req

123− >>= pushStream ctx sid reqvt ii

129+ >>= pushStream ctx settings sid reqvt req ii

124130 >>= responseBuilderBody s0 hs0 b

125131 ResponseFile s0 hs0 p mp

126132 | noBody s0 -> responseNoBody s0 hs0

127133 | otherwise -> getHTTP2Data req

128− >>= pushStream ctx sid reqvt ii

134+ >>= pushStream ctx settings sid reqvt req ii

129135 >>= responseFileXXX s0 hs0 p mp

130136 ResponseRaw _ _ -> error "HTTP/2 does not support ResponseRaw"

131137 where

warp/Network/Wai/Handler/Warp/Settings.hs+5

@@ -101,6 +101,10 @@ data Settings = Settings

101101 -- ^ A log function. Default: no action.

102102 --

103103 -- Since 3.X.X.

104+ , settingsServerPushLogger :: SockAddr -> ByteString -> Integer -> ByteString -> Maybe ByteString -> IO ()

105+ -- ^ A HTTP/2 server push log function. Default: no action.

106+ --

107+ -- Since 3.X.X.

104108 , settingsGracefulShutdownTimeout :: Maybe Int

105109 -- ^ An optional timeout to limit the time (in seconds) waiting for

106110 -- a graceful shutdown of the web server.

@@ -140,6 +144,7 @@ defaultSettings = Settings

140144 , settingsSlowlorisSize = 2048

141145 , settingsHTTP2Enabled = True

142146 , settingsLogger = \_ _ _ -> return ()

147+ , settingsServerPushLogger = \_ _ _ _ _ -> return ()

143148 , settingsGracefulShutdownTimeout = Nothing

144149 }

145150