@@ -21,6 +21,7 @@ import Network (sClose, Socket)
2121import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6))
2222import qualified Network.Socket.ByteString as Sock
2323import Network.Wai
24+import Network.Wai.HTTP2 (Http2Application)
2425import Network.Wai.Handler.Warp.Buffer
2526import Network.Wai.Handler.Warp.Counter
2627import qualified Network.Wai.Handler.Warp.Date as D
@@ -68,10 +69,18 @@ allowInterrupt :: IO ()
6869allowInterrupt = unblock $ return ()
6970#endif
7071
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
75+
7176-- | Run an 'Application' on the given port.
7277-- This calls 'runSettings' with 'defaultSettings'.
7378run :: Port -> Application -> IO ()
74−run p = runSettings defaultSettings { settingsPort = p }
79+run = runWithPromotedApp . runHttp2
80+
81+-- | The HTTP/2-aware eqivalent of 'run'.
82+runHttp2 :: Port -> Http2Application -> Application -> IO ()
83+runHttp2 p = runHttp2Settings defaultSettings { settingsPort = p }
7584
7685-- | Run an 'Application' on the port present in the @PORT@
7786-- environment variable. Uses the 'Port' given when the variable is unset.
@@ -79,7 +88,11 @@ run p = runSettings defaultSettings { settingsPort = p }
7988--
8089-- Since 3.0.9
8190runEnv :: Port -> Application -> IO ()
82−runEnv p app = do
91+runEnv = runWithPromotedApp . runHttp2Env
92+
93+-- | The HTTP/2-aware eqivalent of 'runEnv'.
94+runHttp2Env :: Port -> Http2Application -> Application -> IO ()
95+runHttp2Env p app2 app = do
8396 mp <- fmap (lookup "PORT") getEnvironment
8497
8598 maybe (run p app) runReadPort mp
@@ -87,20 +100,24 @@ runEnv p app = do
87100 where
88101 runReadPort :: String -> IO ()
89102 runReadPort sp = case reads sp of
90− ((p', _):_) -> run p' app
103+ ((p', _):_) -> runHttp2 p' app2 app
91104 _ -> fail $ "Invalid value in $PORT: " ++ sp
92105
93106-- | Run an 'Application' with the given 'Settings'.
94107-- This opens a listen socket on the port defined in 'Settings' and
95108-- calls 'runSettingsSocket'.
96109runSettings :: Settings -> Application -> IO ()
97−runSettings set app = withSocketsDo $
110+runSettings = runWithPromotedApp . runHttp2Settings
111+
112+-- | The HTTP/2-aware eqivalent of 'runSettings'.
113+runHttp2Settings :: Settings -> Http2Application -> Application -> IO ()
114+runHttp2Settings set app2 app = withSocketsDo $
98115 bracket
99116 (bindPortTCP (settingsPort set) (settingsHost set))
100117 sClose
101118 (\socket -> do
102119 setSocketCloseOnExec socket
103− runSettingsSocket set socket app)
120+ runHttp2SettingsSocket set socket app2 app)
104121
105122-- | This installs a shutdown handler for the given socket and
106123-- calls 'runSettingsConnection' with the default connection setup action
@@ -114,9 +131,14 @@ runSettings set app = withSocketsDo $
114131-- Note that the 'settingsPort' will still be passed to 'Application's via the
115132-- 'serverPort' record.
116133runSettingsSocket :: Settings -> Socket -> Application -> IO ()
117−runSettingsSocket set socket app = do
134+runSettingsSocket set socket = runWithPromotedApp $
135+ runHttp2SettingsSocket set socket
136+
137+-- | The HTTP/2-aware eqivalent of 'runSettingsSocket'.
138+runHttp2SettingsSocket :: Settings -> Socket -> Http2Application -> Application -> IO ()
139+runHttp2SettingsSocket set socket app2 app = do
118140 settingsInstallShutdownHandler set closeListenSocket
119− runSettingsConnection set getConn app
141+ runHttp2SettingsConnection set getConn app2 app
120142 where
121143 getConn = do
122144#if WINDOWS
@@ -140,7 +162,13 @@ runSettingsSocket set socket app = do
140162--
141163-- Since 1.3.5
142164runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
143−runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMaker app
165+runSettingsConnection set getConn = runWithPromotedApp $
166+ runHttp2SettingsConnection set getConn
167+
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
144172 where
145173 getConnMaker = do
146174 (conn, sa) <- getConn
@@ -149,8 +177,13 @@ runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMa
149177-- | This modifies the connection maker so that it returns 'TCP' for 'Transport'
150178-- (i.e. plain HTTP) then calls 'runSettingsConnectionMakerSecure'.
151179runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()
152−runSettingsConnectionMaker x y =
153− runSettingsConnectionMakerSecure x (go y)
180+runSettingsConnectionMaker x y = runWithPromotedApp $
181+ runHttp2SettingsConnectionMaker x y
182+
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)
154187 where
155188 go = fmap (first (fmap (, TCP)))
156189
@@ -163,14 +196,19 @@ runSettingsConnectionMaker x y =
163196--
164197-- Since 2.1.4
165198runSettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Transport), SockAddr) -> Application -> IO ()
166−runSettingsConnectionMakerSecure set getConnMaker app = do
199+runSettingsConnectionMakerSecure set getConnMaker = runWithPromotedApp $
200+ runHttp2SettingsConnectionMakerSecure set getConnMaker
201+
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
167205 settingsBeforeMainLoop set
168206 counter <- newCounter
169207
170208 D.withDateCache $ \dc ->
171209 F.withFdCache fdCacheDurationInSeconds $ \fc ->
172210 withTimeoutManager $ \tm ->
173− acceptConnection set getConnMaker app dc fc tm counter
211+ acceptConnection set getConnMaker app2 app dc fc tm counter
174212 where
175213 fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
176214 withTimeoutManager f = case settingsManager set of
@@ -195,13 +233,14 @@ runSettingsConnectionMakerSecure set getConnMaker app = do
195233-- Our approach is explained in the comments below.
196234acceptConnection :: Settings
197235 -> IO (IO (Connection, Transport), SockAddr)
236+ -> Http2Application
198237 -> Application
199238 -> D.DateCache
200239 -> Maybe F.MutableFdCache
201240 -> T.Manager
202241 -> Counter
203242 -> IO ()
204−acceptConnection set getConnMaker app dc fc tm counter = do
243+acceptConnection set getConnMaker app2 app dc fc tm counter = do
205244 -- First mask all exceptions in acceptLoop. This is necessary to
206245 -- ensure that no async exception is throw between the call to
207246 -- acceptNewConnection and the registering of connClose.
@@ -223,7 +262,7 @@ acceptConnection set getConnMaker app dc fc tm counter = do
223262 case mx of
224263 Nothing -> return ()
225264 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
227266 acceptLoop
228267
229268 acceptNewConnection = do
@@ -247,13 +286,14 @@ acceptConnection set getConnMaker app dc fc tm counter = do
247286fork :: Settings
248287 -> IO (Connection, Transport)
249288 -> SockAddr
289+ -> Http2Application
250290 -> Application
251291 -> D.DateCache
252292 -> Maybe F.MutableFdCache
253293 -> T.Manager
254294 -> Counter
255295 -> IO ()
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 ->
257297 -- Run the connection maker to get a new connection, and ensure
258298 -- that the connection is closed. If the mkConn call throws an
259299 -- 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 ->
284324
285325 -- Actually serve this connection.
286326 -- 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
288328 where
289329 closeConn (conn, _transport) = connClose conn
290330
@@ -296,9 +336,10 @@ serveConnection :: Connection
296336 -> SockAddr
297337 -> Transport
298338 -> Settings
339+ -> Http2Application
299340 -> Application
300341 -> IO ()
301−serveConnection conn ii origAddr transport settings app = do
342+serveConnection conn ii origAddr transport settings app2 app = do
302343 -- fixme: Upgrading to HTTP/2 should be supported.
303344 (h2,bs) <- if isHTTP2 transport then
304345 return (True, "")
@@ -311,7 +352,7 @@ serveConnection conn ii origAddr transport settings app = do
311352 if h2 then do
312353 recvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
313354 -- fixme: origAddr
314− http2 conn ii origAddr transport settings recvN $ promoteApplication app
355+ http2 conn ii origAddr transport settings recvN app2
315356 else do
316357 istatus <- newIORef False
317358 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))