git.iko.soy/typeable/wai
on master help sign in
Honor the ENABLE_PUSH setting
f043d8cAndrew Pritchard
wai/Network/Wai/HTTP2.hs+1−1
compare with master
unifiedsplit
@@ -34,7 +34,7 @@ data PushPromise = PushPromise
34
34
35-- | The type of an HTTP\/2 request: a normal HTTP request and an action to
35-- | The type of an HTTP\/2 request: a normal HTTP request and an action to
36-- push streams associated with this request.
36-- push streams associated with this request.
37−type Request = (H1.Request, PushPromise -> Responder -> IO ())
37+type Request = (H1.Request, PushPromise -> Responder -> IO Bool)
38
38
39-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
39-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
40type Http2Application = Request -> Responder
40type Http2Application = Request -> Responder
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+21−17
@@ -92,28 +92,32 @@ cleanupStream ctx@Context{outputQ} set strm req me = do
92 Nothing -> return ()
92 Nothing -> return ()
93 Just e -> S.settingsOnException set req e
93 Just e -> S.settingsOnException set req e
94
94
95−pushResponder :: Context -> S.Settings -> Stream -> PushPromise -> Responder -> IO ()
95+pushResponder :: Context -> S.Settings -> Stream -> PushPromise -> Responder -> IO Bool
96pushResponder ctx set strm promise responder = do
96pushResponder ctx set strm promise responder = do
97 let Context{ http2settings
97 let Context{ http2settings
98 , nextPushStreamId
98 , nextPushStreamId
99 , streamTable
99 , streamTable
100 } = ctx
100 } = ctx
101+ enabled <- enablePush <$> readIORef http2settings
102+ when enabled $ do
101− -- Claim the next outgoing stream.
103+ -- Claim the next outgoing stream.
102− newSid <- atomicModifyIORef nextPushStreamId $ \sid -> (sid+2, sid)
104+ newSid <- atomicModifyIORef nextPushStreamId $ \sid -> (sid+2, sid)
103− ws <- initialWindowSize <$> readIORef http2settings
105+ ws <- initialWindowSize <$> readIORef http2settings
104−
106+
105− newStrm <- newStream newSid ws
107+ newStrm <- newStream newSid ws
106− opened ctx newStrm
108+ writeIORef (streamPriority newStrm) $
107− insert streamTable newSid newStrm
108−
109− let pri = Priority False (streamNumber strm) 16
109+ Priority False (streamNumber strm) 16
110+ opened ctx newStrm
111+ insert streamTable newSid newStrm
112+
110− mkOutput = OPush strm promise
113+ let mkOutput = OPush strm promise
111− tickle = return ()
114+ tickle = return ()
112− respond = runStream ctx mkOutput
115+ respond = runStream ctx mkOutput
113−
116+
114− -- TODO(awpr): synthesize a Request for 'settingsOnException'?
117+ -- TODO(awpr): synthesize a Request for 'settingsOnException'?
115− runResponder responder respond tickle newStrm `E.catch`
118+ runResponder responder respond tickle newStrm `E.catch`
116− (cleanupStream ctx set strm Nothing . Just)
119+ (cleanupStream ctx set strm Nothing . Just)
120+ return enabled
117
121
118data Break = Break deriving (Show, Typeable)
122data Break = Break deriving (Show, Typeable)
119
123