@@ -21,6 +21,7 @@ import Network (sClose, Socket)
21import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6))
21import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6))
22import qualified Network.Socket.ByteString as Sock
22import qualified Network.Socket.ByteString as Sock
23import Network.Wai
23import Network.Wai
24+import Network.Wai.HTTP2 (Http2Application)
24import Network.Wai.Handler.Warp.Buffer
25import Network.Wai.Handler.Warp.Buffer
25import Network.Wai.Handler.Warp.Counter
26import Network.Wai.Handler.Warp.Counter
26import qualified Network.Wai.Handler.Warp.Date as D
27import qualified Network.Wai.Handler.Warp.Date as D
@@ -68,10 +69,18 @@ allowInterrupt :: IO ()
68allowInterrupt = unblock $ return ()
69allowInterrupt = unblock $ return ()
72+-- Used to duplicate the 'app' argument for all of the non-HTTP2 variants.
73+runWithPromotedApp :: (Http2Application -> Application -> a) -> Application -> a
74+runWithPromotedApp f = flip f <*> promoteApplication
71-- | Run an 'Application' on the given port.
76-- | Run an 'Application' on the given port.
72-- This calls 'runSettings' with 'defaultSettings'.
77-- This calls 'runSettings' with 'defaultSettings'.
73run :: Port -> Application -> IO ()
78run :: Port -> Application -> IO ()
79+run = runWithPromotedApp . runHttp2
81+-- | The HTTP/2-aware eqivalent of 'run'.
82+runHttp2 :: Port -> Http2Application -> Application -> IO ()
74−run p = runSettings defaultSettings { settingsPort = p }
83+runHttp2 p = runHttp2Settings defaultSettings { settingsPort = p }
76-- | Run an 'Application' on the port present in the @PORT@
85-- | Run an 'Application' on the port present in the @PORT@
77-- environment variable. Uses the 'Port' given when the variable is unset.
86-- environment variable. Uses the 'Port' given when the variable is unset.
@@ -79,7 +88,11 @@ run p = runSettings defaultSettings { settingsPort = p }
80-- Since 3.0.9
89-- Since 3.0.9
81runEnv :: Port -> Application -> IO ()
90runEnv :: Port -> Application -> IO ()
82−runEnv p app = do
91+runEnv = runWithPromotedApp . runHttp2Env
93+-- | The HTTP/2-aware eqivalent of 'runEnv'.
94+runHttp2Env :: Port -> Http2Application -> Application -> IO ()
95+runHttp2Env p app2 app = do
83 mp <- fmap (lookup "PORT") getEnvironment
96 mp <- fmap (lookup "PORT") getEnvironment
85 maybe (run p app) runReadPort mp
98 maybe (run p app) runReadPort mp
@@ -87,20 +100,24 @@ runEnv p app = do
88 runReadPort :: String -> IO ()
101 runReadPort :: String -> IO ()
89 runReadPort sp = case reads sp of
102 runReadPort sp = case reads sp of
90− ((p', _):_) -> run p' app
103+ ((p', _):_) -> runHttp2 p' app2 app
91 _ -> fail $ "Invalid value in $PORT: " ++ sp
104 _ -> fail $ "Invalid value in $PORT: " ++ sp
93-- | Run an 'Application' with the given 'Settings'.
106-- | Run an 'Application' with the given 'Settings'.
94-- This opens a listen socket on the port defined in 'Settings' and
107-- This opens a listen socket on the port defined in 'Settings' and
95-- calls 'runSettingsSocket'.
108-- calls 'runSettingsSocket'.
96runSettings :: Settings -> Application -> IO ()
109runSettings :: Settings -> Application -> IO ()
110+runSettings = runWithPromotedApp . runHttp2Settings
112+-- | The HTTP/2-aware eqivalent of 'runSettings'.
113+runHttp2Settings :: Settings -> Http2Application -> Application -> IO ()
97−runSettings set app = withSocketsDo $
114+runHttp2Settings set app2 app = withSocketsDo $
99 (bindPortTCP (settingsPort set) (settingsHost set))
116 (bindPortTCP (settingsPort set) (settingsHost set))
101 (\socket -> do
118 (\socket -> do
102 setSocketCloseOnExec socket
119 setSocketCloseOnExec socket
103− runSettingsSocket set socket app)
120+ runHttp2SettingsSocket set socket app2 app)
105-- | This installs a shutdown handler for the given socket and
122-- | This installs a shutdown handler for the given socket and
106-- calls 'runSettingsConnection' with the default connection setup action
123-- calls 'runSettingsConnection' with the default connection setup action
@@ -114,9 +131,14 @@ runSettings set app = withSocketsDo $
114-- Note that the 'settingsPort' will still be passed to 'Application's via the
131-- Note that the 'settingsPort' will still be passed to 'Application's via the
115-- 'serverPort' record.
132-- 'serverPort' record.
116runSettingsSocket :: Settings -> Socket -> Application -> IO ()
133runSettingsSocket :: Settings -> Socket -> Application -> IO ()
117−runSettingsSocket set socket app = do
134+runSettingsSocket set socket = runWithPromotedApp $
135+ runHttp2SettingsSocket set socket
137+-- | The HTTP/2-aware eqivalent of 'runSettingsSocket'.
138+runHttp2SettingsSocket :: Settings -> Socket -> Http2Application -> Application -> IO ()
139+runHttp2SettingsSocket set socket app2 app = do
118 settingsInstallShutdownHandler set closeListenSocket
140 settingsInstallShutdownHandler set closeListenSocket
119− runSettingsConnection set getConn app
141+ runHttp2SettingsConnection set getConn app2 app
121 getConn = do
143 getConn = do
122#if WINDOWS
144#if WINDOWS
@@ -140,7 +162,13 @@ runSettingsSocket set socket app = do
141-- Since 1.3.5
163-- Since 1.3.5
142runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
164runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
143−runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMaker app
165+runSettingsConnection set getConn = runWithPromotedApp $
166+ runHttp2SettingsConnection set getConn
168+-- | The HTTP/2-aware eqivalent of 'runSettingsConnection'.
169+runHttp2SettingsConnection :: Settings -> IO (Connection, SockAddr) -> Http2Application -> Application -> IO ()
170+runHttp2SettingsConnection set getConn app2 app =
171+ runHttp2SettingsConnectionMaker set getConnMaker app2 app
145 getConnMaker = do
173 getConnMaker = do
146 (conn, sa) <- getConn
174 (conn, sa) <- getConn
@@ -149,8 +177,13 @@ runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMa
149-- | This modifies the connection maker so that it returns 'TCP' for 'Transport'
177-- | This modifies the connection maker so that it returns 'TCP' for 'Transport'
150-- (i.e. plain HTTP) then calls 'runSettingsConnectionMakerSecure'.
178-- (i.e. plain HTTP) then calls 'runSettingsConnectionMakerSecure'.
151runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()
179runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()
152−runSettingsConnectionMaker x y =
180+runSettingsConnectionMaker x y = runWithPromotedApp $
153− runSettingsConnectionMakerSecure x (go y)
181+ runHttp2SettingsConnectionMaker x y
183+-- | The HTTP/2-aware eqivalent of 'runSettingsConnectionMaker'.
184+runHttp2SettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Http2Application -> Application -> IO ()
185+runHttp2SettingsConnectionMaker x y =
186+ runHttp2SettingsConnectionMakerSecure x (go y)
155 go = fmap (first (fmap (, TCP)))
188 go = fmap (first (fmap (, TCP)))
@@ -163,14 +196,19 @@ runSettingsConnectionMaker x y =
164-- Since 2.1.4
197-- Since 2.1.4
165runSettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Transport), SockAddr) -> Application -> IO ()
198runSettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Transport), SockAddr) -> Application -> IO ()
166−runSettingsConnectionMakerSecure set getConnMaker app = do
199+runSettingsConnectionMakerSecure set getConnMaker = runWithPromotedApp $
200+ runHttp2SettingsConnectionMakerSecure set getConnMaker
202+-- | The HTTP/2-aware eqivalent of 'runSettingsConnectionMakerSecure'.
203+runHttp2SettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Transport), SockAddr) -> Http2Application -> Application -> IO ()
204+runHttp2SettingsConnectionMakerSecure set getConnMaker app2 app = do
167 settingsBeforeMainLoop set
205 settingsBeforeMainLoop set
168 counter <- newCounter
206 counter <- newCounter
170 D.withDateCache $ \dc ->
208 D.withDateCache $ \dc ->
171 F.withFdCache fdCacheDurationInSeconds $ \fc ->
209 F.withFdCache fdCacheDurationInSeconds $ \fc ->
172 withTimeoutManager $ \tm ->
210 withTimeoutManager $ \tm ->
173− acceptConnection set getConnMaker app dc fc tm counter
211+ acceptConnection set getConnMaker app2 app dc fc tm counter
175 fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
213 fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
176 withTimeoutManager f = case settingsManager set of
214 withTimeoutManager f = case settingsManager set of
@@ -195,13 +233,14 @@ runSettingsConnectionMakerSecure set getConnMaker app = do
195-- Our approach is explained in the comments below.
233-- Our approach is explained in the comments below.
196acceptConnection :: Settings
234acceptConnection :: Settings
197 -> IO (IO (Connection, Transport), SockAddr)
235 -> IO (IO (Connection, Transport), SockAddr)
198 -> Application
237 -> Application
199 -> D.DateCache
238 -> D.DateCache
200 -> Maybe F.MutableFdCache
239 -> Maybe F.MutableFdCache
201 -> T.Manager
240 -> T.Manager
202 -> Counter
241 -> Counter
204−acceptConnection set getConnMaker app dc fc tm counter = do
243+acceptConnection set getConnMaker app2 app dc fc tm counter = do
205 -- First mask all exceptions in acceptLoop. This is necessary to
244 -- First mask all exceptions in acceptLoop. This is necessary to
206 -- ensure that no async exception is throw between the call to
245 -- ensure that no async exception is throw between the call to
207 -- acceptNewConnection and the registering of connClose.
246 -- acceptNewConnection and the registering of connClose.
@@ -223,7 +262,7 @@ acceptConnection set getConnMaker app dc fc tm counter = do
223 case mx of
262 case mx of
224 Nothing -> return ()
263 Nothing -> return ()
225 Just (mkConn, addr) -> do
264 Just (mkConn, addr) -> do
226− fork set mkConn addr app dc fc tm counter
265+ fork set mkConn addr app2 app dc fc tm counter
227 acceptLoop
266 acceptLoop
229 acceptNewConnection = do
268 acceptNewConnection = do
@@ -247,13 +286,14 @@ acceptConnection set getConnMaker app dc fc tm counter = do
247fork :: Settings
286fork :: Settings
248 -> IO (Connection, Transport)
287 -> IO (Connection, Transport)
249 -> SockAddr
288 -> SockAddr
250 -> Application
290 -> Application
251 -> D.DateCache
291 -> D.DateCache
252 -> Maybe F.MutableFdCache
292 -> Maybe F.MutableFdCache
253 -> T.Manager
293 -> T.Manager
254 -> Counter
294 -> Counter
256−fork set mkConn addr app dc fc tm counter = settingsFork set $ \ unmask ->
296+fork set mkConn addr app2 app dc fc tm counter = settingsFork set $ \ unmask ->
257 -- Run the connection maker to get a new connection, and ensure
297 -- Run the connection maker to get a new connection, and ensure
258 -- that the connection is closed. If the mkConn call throws an
298 -- that the connection is closed. If the mkConn call throws an
259 -- exception, we will leak the connection. If the mkConn call is
299 -- exception, we will leak the connection. If the mkConn call is
@@ -284,7 +324,7 @@ fork set mkConn addr app dc fc tm counter = settingsFork set $ \ unmask ->
285 -- Actually serve this connection.
325 -- Actually serve this connection.
286 -- bracket with closeConn above ensures the connection is closed.
326 -- bracket with closeConn above ensures the connection is closed.
287− when goingon $ serveConnection conn ii addr transport set app
327+ when goingon $ serveConnection conn ii addr transport set app2 app
289 closeConn (conn, _transport) = connClose conn
329 closeConn (conn, _transport) = connClose conn
@@ -296,9 +336,10 @@ serveConnection :: Connection
296 -> SockAddr
336 -> SockAddr
297 -> Transport
337 -> Transport
298 -> Settings
338 -> Settings
299 -> Application
340 -> Application
301−serveConnection conn ii origAddr transport settings app = do
342+serveConnection conn ii origAddr transport settings app2 app = do
302 -- fixme: Upgrading to HTTP/2 should be supported.
343 -- fixme: Upgrading to HTTP/2 should be supported.
303 (h2,bs) <- if isHTTP2 transport then
344 (h2,bs) <- if isHTTP2 transport then
304 return (True, "")
345 return (True, "")
@@ -311,7 +352,7 @@ serveConnection conn ii origAddr transport settings app = do
311 if h2 then do
352 if h2 then do
312 recvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
353 recvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
313 -- fixme: origAddr
354 -- fixme: origAddr
314− http2 conn ii origAddr transport settings recvN $ promoteApplication app
355+ http2 conn ii origAddr transport settings recvN app2
316 istatus <- newIORef False
357 istatus <- newIORef False
317 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))
358 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))