git.iko.soy/typeable/wai
on master help sign in
Merge pull request #124 from notogawa/MultiThreadedTLSHandshake
e033cbdMichael Snoyman
warp-tls/Network/Wai/Handler/WarpTLS.hs+5−7
compare with master
unifiedsplit
@@ -56,14 +56,11 @@ runTLSSocket tset set sock app = do
56 , TLS.pCertificates = zip certs $ (Just pk):repeat Nothing
56 , TLS.pCertificates = zip certs $ (Just pk):repeat Nothing
57 }
57 }
58#endif
58#endif
59− runSettingsConnection set (getter params sock) app
59+ runSettingsConnectionMaker set (getter params sock) app
60 where
60 where
61− retry :: Socket -> TLS.TLSParams -> Socket -> SomeException -> IO (Connection, SockAddr)
62− retry s a b _ = sClose s >> getter a b
63−
64 getter params sock = do
61 getter params sock = do
65 (s, sa) <- accept sock
62 (s, sa) <- accept sock
66− handle (retry s params sock) $ do
63+ let mkConn = do
67 (fromClient, firstBS) <- sourceSocket s C.$$+ CL.peek
64 (fromClient, firstBS) <- sourceSocket s C.$$+ CL.peek
68 let toClient = sinkSocket s
65 let toClient = sinkSocket s
69 ifromClient <- I.newIORef fromClient
66 ifromClient <- I.newIORef fromClient
@@ -106,12 +103,13 @@ runTLSSocket tset set sock app = do
106 sClose s
103 sClose s
107 , connRecv = TLS.recvData ctx
104 , connRecv = TLS.recvData ctx
108 }
105 }
109− return (conn, sa)
106+ return conn
110 else do
107 else do
111 let conn = (socketConnection s)
108 let conn = (socketConnection s)
112 { connRecv = getNext $ fmap (fromMaybe B.empty) C.await
109 { connRecv = getNext $ fmap (fromMaybe B.empty) C.await
113 }
110 }
114− return (conn, sa)
111+ return conn
112+ return (mkConn, sa)
115
113
116runTLS :: TLSSettings -> Settings -> Application -> IO ()
114runTLS :: TLSSettings -> Settings -> Application -> IO ()
117runTLS tset set app =
115runTLS tset set app =
warp/Network/Wai/Handler/Warp.hs+1
@@ -38,6 +38,7 @@ module Network.Wai.Handler.Warp (
38 -- * Connection
38 -- * Connection
39 , Connection (..)
39 , Connection (..)
40 , runSettingsConnection
40 , runSettingsConnection
41+ , runSettingsConnectionMaker
41 -- * Datatypes
42 -- * Datatypes
42 , Port
43 , Port
43 , InvalidRequest (..)
44 , InvalidRequest (..)
warp/Network/Wai/Handler/Warp/Run.hs+10−2
@@ -129,7 +129,14 @@ runSettingsSocket set socket app =
129 return (socketConnection conn, sa)
129 return (socketConnection conn, sa)
130
130
131runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
131runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
132−runSettingsConnection set getConn app = do
132+runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMaker app
133+ where
134+ getConnMaker = do
135+ (conn, sa) <- getConn
136+ return (return conn, sa)
137+
138+runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()
139+runSettingsConnectionMaker set getConn app = do
133 tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
140 tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
134 $ settingsManager set
141 $ settingsManager set
135#if SENDFILEFD
142#if SENDFILEFD
@@ -140,9 +147,10 @@ runSettingsConnection set getConn app = do
140#endif
147#endif
141 mask $ \restore -> forever $ do
148 mask $ \restore -> forever $ do
142 allowInterrupt
149 allowInterrupt
143− (conn, addr) <- getConnLoop
150+ (mkConn, addr) <- getConnLoop
144 void . forkIO $ do
151 void . forkIO $ do
145 th <- T.registerKillThread tm
152 th <- T.registerKillThread tm
153+ conn <- mkConn
146#if SENDFILEFD
154#if SENDFILEFD
147 let cleaner = Cleaner th fc
155 let cleaner = Cleaner th fc
148#else
156#else