git.iko.soy/typeable/wai
on master help sign in
defining a logger for HTTP/2 server push.
dda63bcKazu Yamamoto
warp/Network/Wai/Handler/Warp.hs+5
compare with master
unifiedsplit
@@ -70,6 +70,7 @@ module Network.Wai.Handler.Warp (
70 , setSlowlorisSize
70 , setSlowlorisSize
71 , setHTTP2Disabled
71 , setHTTP2Disabled
72 , setLogger
72 , setLogger
73+ , setServerPushLogger
73 , setGracefulShutdownTimeout
74 , setGracefulShutdownTimeout
74 -- ** Getters
75 -- ** Getters
75 , getPort
76 , getPort
@@ -372,6 +373,10 @@ setLogger :: (Request -> H.Status -> Maybe Integer -> IO ())
372 -> Settings -> Settings
373 -> Settings -> Settings
373setLogger lgr y = y { settingsLogger = lgr }
374setLogger lgr y = y { settingsLogger = lgr }
374
375
376+setServerPushLogger :: (SockAddr -> ByteString -> Integer -> ByteString -> Maybe ByteString -> IO ())
377+ -> Settings -> Settings
378+setServerPushLogger lgr y = y { settingsServerPushLogger = lgr }
379+
375-- | Set the graceful shutdown timeout. A timeout of `Nothing' will
380-- | Set the graceful shutdown timeout. A timeout of `Nothing' will
376-- wait indefinitely, and a number, if provided, will be treated as seconds
381-- wait indefinitely, and a number, if provided, will be treated as seconds
377-- to wait for requests to finish, before shutting down the server entirely.
382-- 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
53 -> Response
53 -> Response
54 -> IO ResponseReceived
54 -> IO ResponseReceived
55
55
56+pushStream :: Context -> S.Settings
56−pushStream :: Context -> StreamId -> ValueTable -> InternalInfo
57+ -> StreamId -> ValueTable -> Request -> InternalInfo
57 -> Maybe HTTP2Data
58 -> Maybe HTTP2Data
58 -> IO (Stream -> Rspn -> InternalInfo -> IO () -> Output, IO ())
59 -> IO (Stream -> Rspn -> InternalInfo -> IO () -> Output, IO ())
59−pushStream _ _ _ _ Nothing = return (ORspn, return ())
60+pushStream _ _ _ _ _ _ Nothing = return (ORspn, return ())
60−pushStream ctx@Context{http2settings,outputQ} pid reqvt ii (Just h2d)
61+pushStream ctx@Context{http2settings,outputQ} settings pid reqvt req ii (Just h2d)
61 | len == 0 = return (ORspn, return ())
62 | len == 0 = return (ORspn, return ())
62 | otherwise = do
63 | otherwise = do
63 pushable <- enablePush <$> readIORef http2settings
64 pushable <- enablePush <$> readIORef http2settings
@@ -73,6 +74,10 @@ pushStream ctx@Context{http2settings,outputQ} pid reqvt ii (Just h2d)
73 where
74 where
74 !pps0 = http2dataPushPromise h2d
75 !pps0 = http2dataPushPromise h2d
75 !len = length pps0
76 !len = length pps0
77+ !pushLogger = S.settingsServerPushLogger settings
78+ !sa = remoteHost req
79+ !mua = requestHeaderUserAgent req
80+ !referer = rawPathInfo req
76 increment tvar = atomically $ modifyTVar' tvar (+1)
81 increment tvar = atomically $ modifyTVar' tvar (+1)
77 waiter lim tvar = atomically $ do
82 waiter lim tvar = atomically $ do
78 n <- readTVar tvar
83 n <- readTVar tvar
@@ -100,6 +105,7 @@ pushStream ctx@Context{http2settings,outputQ} pid reqvt ii (Just h2d)
100 !rsp = RspnFile H.ok200 (ths,vt) file (Just part)
105 !rsp = RspnFile H.ok200 (ths,vt) file (Just part)
101 !ths = (tokenLastModified,date) :
106 !ths = (tokenLastModified,date) :
102 addContentHeadersForFilePart ths0 part
107 addContentHeadersForFilePart ths0 part
108+ pushLogger sa path size referer mua
103 let out = OPush strm promisedRequest rsp ii (increment tvar) pid
109 let out = OPush strm promisedRequest rsp ii (increment tvar) pid
104 enqueueOutput outputQ out
110 enqueueOutput outputQ out
105 push tvar pps (n + 1)
111 push tvar pps (n + 1)
@@ -114,18 +120,18 @@ response settings ctx@Context{outputQ} mgr ii reqvt tconf strm req rsp = case rs
114 | noBody s0 -> responseNoBody s0 hs0
120 | noBody s0 -> responseNoBody s0 hs0
115 | isHead -> responseNoBody s0 hs0
121 | isHead -> responseNoBody s0 hs0
116 | otherwise -> getHTTP2Data req
122 | otherwise -> getHTTP2Data req
117− >>= pushStream ctx sid reqvt ii
123+ >>= pushStream ctx settings sid reqvt req ii
118 >>= responseStreaming s0 hs0 strmbdy
124 >>= responseStreaming s0 hs0 strmbdy
119 ResponseBuilder s0 hs0 b
125 ResponseBuilder s0 hs0 b
120 | noBody s0 -> responseNoBody s0 hs0
126 | noBody s0 -> responseNoBody s0 hs0
121 | isHead -> responseNoBody s0 hs0
127 | isHead -> responseNoBody s0 hs0
122 | otherwise -> getHTTP2Data req
128 | otherwise -> getHTTP2Data req
123− >>= pushStream ctx sid reqvt ii
129+ >>= pushStream ctx settings sid reqvt req ii
124 >>= responseBuilderBody s0 hs0 b
130 >>= responseBuilderBody s0 hs0 b
125 ResponseFile s0 hs0 p mp
131 ResponseFile s0 hs0 p mp
126 | noBody s0 -> responseNoBody s0 hs0
132 | noBody s0 -> responseNoBody s0 hs0
127 | otherwise -> getHTTP2Data req
133 | otherwise -> getHTTP2Data req
128− >>= pushStream ctx sid reqvt ii
134+ >>= pushStream ctx settings sid reqvt req ii
129 >>= responseFileXXX s0 hs0 p mp
135 >>= responseFileXXX s0 hs0 p mp
130 ResponseRaw _ _ -> error "HTTP/2 does not support ResponseRaw"
136 ResponseRaw _ _ -> error "HTTP/2 does not support ResponseRaw"
131 where
137 where
warp/Network/Wai/Handler/Warp/Settings.hs+5
@@ -101,6 +101,10 @@ data Settings = Settings
101 -- ^ A log function. Default: no action.
101 -- ^ A log function. Default: no action.
102 --
102 --
103 -- Since 3.X.X.
103 -- 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.
104 , settingsGracefulShutdownTimeout :: Maybe Int
108 , settingsGracefulShutdownTimeout :: Maybe Int
105 -- ^ An optional timeout to limit the time (in seconds) waiting for
109 -- ^ An optional timeout to limit the time (in seconds) waiting for
106 -- a graceful shutdown of the web server.
110 -- a graceful shutdown of the web server.
@@ -140,6 +144,7 @@ defaultSettings = Settings
140 , settingsSlowlorisSize = 2048
144 , settingsSlowlorisSize = 2048
141 , settingsHTTP2Enabled = True
145 , settingsHTTP2Enabled = True
142 , settingsLogger = \_ _ _ -> return ()
146 , settingsLogger = \_ _ _ -> return ()
147+ , settingsServerPushLogger = \_ _ _ _ _ -> return ()
143 , settingsGracefulShutdownTimeout = Nothing
148 , settingsGracefulShutdownTimeout = Nothing
144 }
149 }
145
150