git.iko.soy/typeable/wai
on master help sign in
Cleaner -> InternalInfo.
da33d04Kazu Yamamoto
warp/Network/Wai/Handler/Warp.hs+1−1
compare with master
unifiedsplit
@@ -48,7 +48,7 @@ module Network.Wai.Handler.Warp (
48 -- ** Time out manager
48 -- ** Time out manager
49 , module Network.Wai.Handler.Warp.Timeout
49 , module Network.Wai.Handler.Warp.Timeout
50 -- ** Data types
50 -- ** Data types
51− , Cleaner
51+ , InternalInfo
52 -- ** Request and response
52 -- ** Request and response
53 , parseRequest
53 , parseRequest
54 , sendResponse
54 , sendResponse
warp/Network/Wai/Handler/Warp/Response.hs+8−8
@@ -36,18 +36,18 @@ import Numeric (showInt)
36----------------------------------------------------------------
36----------------------------------------------------------------
37
37
38sendResponse :: Settings
38sendResponse :: Settings
39− -> Cleaner -> Request -> Connection
39+ -> InternalInfo -> Request -> Connection
40 -> (forall a. IO a -> IO a) -- ^ restore masking state
40 -> (forall a. IO a -> IO a) -- ^ restore masking state
41 -> Response
41 -> Response
42 -> IO Bool
42 -> IO Bool
43
43
44----------------------------------------------------------------
44----------------------------------------------------------------
45
45
46−sendResponse settings cleaner req conn restore (ResponseFile s0 hs0 path mpart0) =
46+sendResponse settings ii req conn restore (ResponseFile s0 hs0 path mpart0) =
47 restore $ headerAndLength >>= sendResponse'
47 restore $ headerAndLength >>= sendResponse'
48 where
48 where
49 hs = addAccept hs0
49 hs = addAccept hs0
50− th = threadHandle cleaner
50+ th = threadHandle ii
51 headerAndLength = liftIO . try $ do
51 headerAndLength = liftIO . try $ do
52 (hadLength, cl) <-
52 (hadLength, cl) <-
53 case readInt <$> checkLength hs of
53 case readInt <$> checkLength hs of
@@ -98,13 +98,13 @@ sendResponse settings cleaner req conn restore (ResponseFile s0 hs0 path mpart0)
98 (isPersist,_) = infoFromRequest req
98 (isPersist,_) = infoFromRequest req
99
99
100 sendResponse' (Left (_ :: SomeException)) =
100 sendResponse' (Left (_ :: SomeException)) =
101− sendResponse settings cleaner req conn restore notFound
101+ sendResponse settings ii req conn restore notFound
102 where
102 where
103 notFound = responseLBS H.status404 [(H.hContentType, "text/plain")] "File not found"
103 notFound = responseLBS H.status404 [(H.hContentType, "text/plain")] "File not found"
104
104
105----------------------------------------------------------------
105----------------------------------------------------------------
106
106
107−sendResponse settings cleaner req conn restore (ResponseBuilder s hs b)
107+sendResponse settings ii req conn restore (ResponseBuilder s hs b)
108 | hasBody s req = restore $ do
108 | hasBody s req = restore $ do
109 header <- composeHeaderBuilder settings version s hs needsChunked
109 header <- composeHeaderBuilder settings version s hs needsChunked
110 let body
110 let body
@@ -120,14 +120,14 @@ sendResponse settings cleaner req conn restore (ResponseBuilder s hs b)
120 T.tickle th
120 T.tickle th
121 return isPersist
121 return isPersist
122 where
122 where
123− th = threadHandle cleaner
123+ th = threadHandle ii
124 version = httpVersion req
124 version = httpVersion req
125 reqinfo@(isPersist,_) = infoFromRequest req
125 reqinfo@(isPersist,_) = infoFromRequest req
126 (isKeepAlive, needsChunked) = infoFromResponse hs reqinfo
126 (isKeepAlive, needsChunked) = infoFromResponse hs reqinfo
127
127
128----------------------------------------------------------------
128----------------------------------------------------------------
129
129
130−sendResponse settings cleaner req conn restore (ResponseSource s hs withBodyFlush)
130+sendResponse settings ii req conn restore (ResponseSource s hs withBodyFlush)
131 | hasBody s req = withBodyFlush $ \bodyFlush -> restore $ do
131 | hasBody s req = withBodyFlush $ \bodyFlush -> restore $ do
132 header <- liftIO $ composeHeaderBuilder settings version s hs needsChunked
132 header <- liftIO $ composeHeaderBuilder settings version s hs needsChunked
133 let src = CL.sourceList [header] `mappend` cbody bodyFlush
133 let src = CL.sourceList [header] `mappend` cbody bodyFlush
@@ -138,7 +138,7 @@ sendResponse settings cleaner req conn restore (ResponseSource s hs withBodyFlus
138 T.tickle th
138 T.tickle th
139 return isPersist
139 return isPersist
140 where
140 where
141− th = threadHandle cleaner
141+ th = threadHandle ii
142 cbody bodyFlush =
142 cbody bodyFlush =
143 if needsChunked then body $= chunk else body
143 if needsChunked then body $= chunk else body
144 where
144 where
warp/Network/Wai/Handler/Warp/Run.hs+7−7
@@ -172,7 +172,7 @@ runSettingsConnectionMaker set getConnMaker app = do
172 -- We need to register a timeout handler for this thread, and
172 -- We need to register a timeout handler for this thread, and
173 -- cancel that handler as soon as we exit.
173 -- cancel that handler as soon as we exit.
174 bracket (T.registerKillThread tm) T.cancel $ \th ->
174 bracket (T.registerKillThread tm) T.cancel $ \th ->
175− let cleaner = Cleaner th fc
175+ let ii = InternalInfo th fc
176 conn = setSendFile conn' fc
176 conn = setSendFile conn' fc
177 -- We now have fully registered a connection close handler
177 -- We now have fully registered a connection close handler
178 -- in the case of all exceptions, so it is safe to one
178 -- in the case of all exceptions, so it is safe to one
@@ -186,7 +186,7 @@ runSettingsConnectionMaker set getConnMaker app = do
186 bracket_ onOpen onClose $
186 bracket_ onOpen onClose $
187
187
188 -- Actually serve this connection.
188 -- Actually serve this connection.
189− serveConnection th set cleaner app conn addr
189+ serveConnection th set ii app conn addr
190 where
190 where
191 -- FIXME: only IOEception is caught. What about other exceptions?
191 -- FIXME: only IOEception is caught. What about other exceptions?
192 getConnLoop = getConnMaker `E.catch` \(e :: IOException) -> do
192 getConnLoop = getConnMaker `E.catch` \(e :: IOException) -> do
@@ -209,15 +209,15 @@ runSettingsConnectionMaker set getConnMaker app = do
209
209
210serveConnection :: T.Handle
210serveConnection :: T.Handle
211 -> Settings
211 -> Settings
212− -> Cleaner
212+ -> InternalInfo
213 -> Application -> Connection -> SockAddr-> IO ()
213 -> Application -> Connection -> SockAddr-> IO ()
214−serveConnection timeoutHandle settings cleaner app conn remoteHost' =
214+serveConnection timeoutHandle settings ii app conn remoteHost' =
215 (serveConnection'' $ connSource conn th) `onException` send500
215 (serveConnection'' $ connSource conn th) `onException` send500
216 where
216 where
217− th = threadHandle cleaner
217+ th = threadHandle ii
218
218
219 send500 = void $ mask $ \restore ->
219 send500 = void $ mask $ \restore ->
220− sendResponse settings cleaner dummyreq conn restore internalError
220+ sendResponse settings ii dummyreq conn restore internalError
221
221
222 dummyreq = defaultRequest { remoteHost = remoteHost' }
222 dummyreq = defaultRequest { remoteHost = remoteHost' }
223
223
@@ -236,7 +236,7 @@ serveConnection timeoutHandle settings cleaner app conn remoteHost' =
236 keepAlive <- mask $ \restore -> do
236 keepAlive <- mask $ \restore -> do
237 res <- restore $ app env
237 res <- restore $ app env
238 liftIO $ T.resume th
238 liftIO $ T.resume th
239− sendResponse settings cleaner env conn restore res
239+ sendResponse settings ii env conn restore res
240
240
241 -- We just send a Response and it takes a time to
241 -- We just send a Response and it takes a time to
242 -- receive a Request again. If we immediately call recv,
242 -- receive a Request again. If we immediately call recv,
warp/Network/Wai/Handler/Warp/Types.hs+1−1
@@ -68,7 +68,7 @@ data Connection = Connection
68----------------------------------------------------------------
68----------------------------------------------------------------
69
69
70-- | A type used to clean up file descriptor caches.
70-- | A type used to clean up file descriptor caches.
71−data Cleaner = Cleaner {
71+data InternalInfo = InternalInfo {
72 threadHandle :: T.Handle
72 threadHandle :: T.Handle
73 , fdCacher :: Maybe F.MutableFdCache
73 , fdCacher :: Maybe F.MutableFdCache
74 }
74 }