on master help sign in
warp-tls: catching up #782
commit4ab4083b299a7e2243a6dd36c07e62424f9a71e4 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 18 Dec 2019, 10:38 (7 years ago) parent2a2e7d0
1 file changed+18−15
warp-tls/Network/Wai/Handler/WarpTLS.hs+18−15
warp-tls/Network/Wai/Handler/WarpTLS.hs+18−15
@@ -281,7 +281,7 @@ runTLSSocket' :: TLSSettings -> Settings -> TLS.Credential -> TLS.SessionManager
281281runTLSSocket' tlsset@TLSSettings{..} set credential mgr sock app =
282282 runSettingsConnectionMakerSecure set get app
283283 where
284− get = getter tlsset sock params
284+ get = getter tlsset set sock params
285285 params = def { -- TLS.ServerParams
286286 TLS.serverWantClientCert = tlsWantClientCert
287287 , TLS.serverCACertificates = []
@@ -322,39 +322,41 @@ alpn xs
322322
323323----------------------------------------------------------------
324324
325−getter :: TLS.TLSParams params => TLSSettings -> Socket -> params -> IO (IO (Connection, Transport), SockAddr)
326−getter tlsset@TLSSettings{..} sock params = do
325+getter :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> params -> IO (IO (Connection, Transport), SockAddr)
326+getter tlsset@TLSSettings{..} set sock params = do
327327#if WINDOWS
328328 (s, sa) <- windowsThreadBlockHack $ accept sock
329329#else
330330 (s, sa) <- accept sock
331331#endif
332332 setSocketCloseOnExec s
333− return (mkConn tlsset s params, sa)
333+ return (mkConn tlsset set s params, sa)
334334
335−mkConn :: TLS.TLSParams params => TLSSettings -> Socket -> params -> IO (Connection, Transport)
336−mkConn tlsset s params = switch `onException` close s
335+mkConn :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> params -> IO (Connection, Transport)
336+mkConn tlsset set s params = switch `onException` close s
337337 where
338338 switch = do
339339 firstBS <- safeRecv s 4096
340340 if not (S.null firstBS) && S.head firstBS == 0x16 then
341− httpOverTls tlsset s firstBS params
341+ httpOverTls tlsset set s firstBS params
342342 else
343− plainHTTP tlsset s firstBS
343+ plainHTTP tlsset set s firstBS
344344
345345----------------------------------------------------------------
346346
347−httpOverTls :: TLS.TLSParams params => TLSSettings -> Socket -> S.ByteString -> params -> IO (Connection, Transport)
348−httpOverTls TLSSettings{..} s bs0 params = do
347+httpOverTls :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> S.ByteString -> params -> IO (Connection, Transport)
348+httpOverTls TLSSettings{..} _set s bs0 params = do
349349 recvN <- makePlainReceiveN s bs0
350350 ctx <- TLS.contextNew (backend recvN) params
351351 TLS.contextHookSetLogging ctx tlsLogging
352352 TLS.handshake ctx
353+ h2 <- (== Just "h2") <$> TLS.getNegotiatedProtocol ctx
354+ isH2 <- I.newIORef h2
353355 writeBuf <- allocateBuffer bufferSize
354356 -- Creating a cache for leftover input data.
355357 ref <- I.newIORef ""
356358 tls <- getTLSinfo ctx
357− return (conn ctx writeBuf ref, tls)
359+ return (conn ctx writeBuf ref isH2, tls)
358360 where
359361 backend recvN = TLS.Backend {
360362 TLS.backendFlush = return ()
@@ -368,7 +370,7 @@ httpOverTls TLSSettings{..} s bs0 params = do
368370 }
369371 sendAll' sock bs = sendAll sock bs `E.catch` \(SomeException _) ->
370372 throwIO ConnectionClosedByPeer
371− conn ctx writeBuf ref = Connection {
373+ conn ctx writeBuf ref isH2 = Connection {
372374 connSendMany = TLS.sendData ctx . L.fromChunks
373375 , connSendAll = sendall
374376 , connSendFile = sendfile
@@ -378,6 +380,7 @@ httpOverTls TLSSettings{..} s bs0 params = do
378380 , connRecvBuf = recvBuf ref
379381 , connWriteBuffer = writeBuf
380382 , connBufferSize = bufferSize
383+ , connHTTP2 = isH2
381384 }
382385 where
383386 sendall = TLS.sendData ctx . L.fromChunks . return
@@ -477,10 +480,10 @@ tryIO = try
477480
478481----------------------------------------------------------------
479482
480−plainHTTP :: TLSSettings -> Socket -> S.ByteString -> IO (Connection, Transport)
481−plainHTTP TLSSettings{..} s bs0 = case onInsecure of
483+plainHTTP :: TLSSettings -> Settings -> Socket -> S.ByteString -> IO (Connection, Transport)
484+plainHTTP TLSSettings{..} set s bs0 = case onInsecure of
482485 AllowInsecure -> do
483− conn' <- socketConnection s
486+ conn' <- socketConnection set s
484487 cachedRef <- I.newIORef bs0
485488 let conn'' = conn'
486489 { connRecv = recvPlain cachedRef (connRecv conn')