git.iko.soy/typeable/wai
on master help sign in
using NamedFieldPuns according to #339.
8ff3212Kazu Yamamoto
warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+4−3
compare with master
unifiedsplit
@@ -1,4 +1,5 @@
1−{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
2
3
3module Network.Wai.Handler.Warp.HTTP2.HPACK where
4module Network.Wai.Handler.Warp.HTTP2.HPACK where
4
5
@@ -20,7 +21,7 @@ import Network.Wai.Handler.Warp.Types
20
21
21hpackEncodeHeader :: Context -> InternalInfo -> S.Settings -> Response
22hpackEncodeHeader :: Context -> InternalInfo -> S.Settings -> Response
22 -> IO Builder
23 -> IO Builder
23−hpackEncodeHeader Context{..} ii settings rsp = do
24+hpackEncodeHeader Context{encodeDynamicTable} ii settings rsp = do
24 hdr1 <- addServerAndDate hdr0
25 hdr1 <- addServerAndDate hdr0
25 let hdr2 = (":status", status) : map (first foldedCase) hdr1
26 let hdr2 = (":status", status) : map (first foldedCase) hdr1
26 ehdrtbl <- readIORef encodeDynamicTable
27 ehdrtbl <- readIORef encodeDynamicTable
@@ -39,7 +40,7 @@ hpackEncodeHeader Context{..} ii settings rsp = do
39----------------------------------------------------------------
40----------------------------------------------------------------
40
41
41hpackDecodeHeader :: HeaderBlockFragment -> Context -> IO HeaderList
42hpackDecodeHeader :: HeaderBlockFragment -> Context -> IO HeaderList
42−hpackDecodeHeader hdrblk Context{..} = do
43+hpackDecodeHeader hdrblk Context{decodeDynamicTable} = do
43 hdrtbl <- readIORef decodeDynamicTable
44 hdrtbl <- readIORef decodeDynamicTable
44 (hdrtbl', hdr) <- decodeHeader hdrtbl hdrblk `E.onException` cleanup
45 (hdrtbl', hdr) <- decodeHeader hdrtbl hdrblk `E.onException` cleanup
45 writeIORef decodeDynamicTable hdrtbl'
46 writeIORef decodeDynamicTable hdrtbl'
warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+9−1
@@ -28,7 +28,15 @@ import Network.Wai.Handler.Warp.Types
28----------------------------------------------------------------
28----------------------------------------------------------------
29
29
30frameReceiver :: Context -> MkReq -> (BufSize -> IO ByteString) -> IO ()
30frameReceiver :: Context -> MkReq -> (BufSize -> IO ByteString) -> IO ()
31−frameReceiver ctx@Context{..} mkreq recvN =
31+frameReceiver ctx@Context{ http2settings
32+ , streamTable
33+ , concurrency
34+ , continued
35+ , currentStreamId
36+ , inputQ
37+ , outputQ
38+ , wait}
39+ mkreq recvN =
32 E.handle sendGoaway loop `E.finally` takeMVar wait
40 E.handle sendGoaway loop `E.finally` takeMVar wait
33 where
41 where
34 sendGoaway (ConnectionError err msg) = do
42 sendGoaway (ConnectionError err msg) = do
warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+17−7
@@ -1,5 +1,6 @@
1−{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE BangPatterns, CPP #-}
2{-# LANGUAGE BangPatterns, CPP #-}
3+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
3
4
4module Network.Wai.Handler.Warp.HTTP2.Sender (frameSender) where
5module Network.Wai.Handler.Warp.HTTP2.Sender (frameSender) where
5
6
@@ -37,7 +38,10 @@ import System.Posix.Types
37----------------------------------------------------------------
38----------------------------------------------------------------
38
39
39unlessClosed :: Context -> Connection -> Stream -> IO () -> IO ()
40unlessClosed :: Context -> Connection -> Stream -> IO () -> IO ()
41+unlessClosed ctx
42+ Connection{connSendAll}
43+ strm@Stream{streamState,streamNumber}
40−unlessClosed ctx Connection{..} strm@Stream{..} body = E.handle resetStream $ do
44+ body = E.handle resetStream $ do
41 state <- readIORef streamState
45 state <- readIORef streamState
42 unless (isClosed state) body
46 unless (isClosed state) body
43 where
47 where
@@ -64,7 +68,9 @@ checkWindowSize connWindow strmWindow outQ out pri body = do
64 body (min cw sw)
68 body (min cw sw)
65
69
66frameSender :: Context -> Connection -> InternalInfo -> S.Settings -> IO ()
70frameSender :: Context -> Connection -> InternalInfo -> S.Settings -> IO ()
67−frameSender ctx@Context{..} conn@Connection{..} ii settings = do
71+frameSender ctx@Context{outputQ,connectionWindow,wait}
72+ conn@Connection{connWriteBuffer,connBufferSize,connSendAll}
73+ ii settings = do
68 connSendAll initialFrame
74 connSendAll initialFrame
69 loop `E.finally` putMVar wait ()
75 loop `E.finally` putMVar wait ()
70 where
76 where
@@ -172,14 +178,16 @@ ResponseRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) Response
172-}
178-}
173
179
174fillResponseBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> Response -> IO Next
180fillResponseBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> Response -> IO Next
181+fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
175−fillResponseBodyGetNext Connection{..} _ off lim (ResponseBuilder _ _ bb) = do
182+ _ off lim (ResponseBuilder _ _ bb) = do
176 let datBuf = connWriteBuffer `plusPtr` off
183 let datBuf = connWriteBuffer `plusPtr` off
177 room = min (connBufferSize - off) lim
184 room = min (connBufferSize - off) lim
178 (len, signal) <- B.runBuilder bb datBuf room
185 (len, signal) <- B.runBuilder bb datBuf room
179 return $ nextForBuilder connWriteBuffer connBufferSize len signal
186 return $ nextForBuilder connWriteBuffer connBufferSize len signal
180
187
181#ifdef WINDOWS
188#ifdef WINDOWS
189+fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
182−fillResponseBodyGetNext Connection{..} _ off lim (ResponseFile _ _ path mpart) = do
190+ _ off lim (ResponseFile _ _ path mpart) = do
183 let datBuf = connWriteBuffer `plusPtr` off
191 let datBuf = connWriteBuffer `plusPtr` off
184 room = min (connBufferSize - off) lim
192 room = min (connBufferSize - off) lim
185 (start, bytes) <- fileStartEnd path mpart
193 (start, bytes) <- fileStartEnd path mpart
@@ -190,7 +198,8 @@ fillResponseBodyGetNext Connection{..} _ off lim (ResponseFile _ _ path mpart) =
190 let bytes' = bytes - fromIntegral len
198 let bytes' = bytes - fromIntegral len
191 return $ nextForFile len connWriteBuffer connBufferSize h bytes' (return ())
199 return $ nextForFile len connWriteBuffer connBufferSize h bytes' (return ())
192#else
200#else
201+fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
193−fillResponseBodyGetNext Connection{..} ii off lim (ResponseFile _ _ path mpart) = do
202+ ii off lim (ResponseFile _ _ path mpart) = do
194 let Just fdcache = fdCacher ii
203 let Just fdcache = fdCacher ii
195 (fd, refresh) <- getFd fdcache path
204 (fd, refresh) <- getFd fdcache path
196 let datBuf = connWriteBuffer `plusPtr` off
205 let datBuf = connWriteBuffer `plusPtr` off
@@ -214,7 +223,8 @@ fileStartEnd _ (Just part) =
214----------------------------------------------------------------
223----------------------------------------------------------------
215
224
216fillStreamBodyGetNext :: Connection -> Int -> WindowSize -> TBQueue Sequence -> TVar Sync -> IO Next
225fillStreamBodyGetNext :: Connection -> Int -> WindowSize -> TBQueue Sequence -> TVar Sync -> IO Next
217−fillStreamBodyGetNext Connection{..} off lim sq tvar = do
226+fillStreamBodyGetNext Connection{connWriteBuffer,connBufferSize}
227+ off lim sq tvar = do
218 let datBuf = connWriteBuffer `plusPtr` off
228 let datBuf = connWriteBuffer `plusPtr` off
219 room = min (connBufferSize - off) lim
229 room = min (connBufferSize - off) lim
220 (leftover, cont, len) <- runStreamBuilder datBuf room sq
230 (leftover, cont, len) <- runStreamBuilder datBuf room sq
warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+4−3
@@ -1,4 +1,5 @@
1−{-# LANGUAGE OverloadedStrings, RecordWildCards, CPP #-}
1+{-# LANGUAGE OverloadedStrings, CPP #-}
2+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
2
3
3module Network.Wai.Handler.Warp.HTTP2.Types where
4module Network.Wai.Handler.Warp.HTTP2.Types where
4
5
@@ -193,12 +194,12 @@ newStream sid win = Stream sid <$> newIORef Idle
193----------------------------------------------------------------
194----------------------------------------------------------------
194
195
195opened :: Context -> Stream -> IO ()
196opened :: Context -> Stream -> IO ()
196−opened Context{..} Stream{..} = do
197+opened Context{concurrency} Stream{streamState} = do
197 atomicModifyIORef' concurrency (\x -> ((x+1),()))
198 atomicModifyIORef' concurrency (\x -> ((x+1),()))
198 writeIORef streamState (Open JustOpened)
199 writeIORef streamState (Open JustOpened)
199
200
200closed :: Context -> Stream -> ClosedCode -> IO ()
201closed :: Context -> Stream -> ClosedCode -> IO ()
201−closed Context{..} Stream{..} cc = do
202+closed Context{concurrency} Stream{streamState} cc = do
202 atomicModifyIORef' concurrency (\x -> ((x-1),()))
203 atomicModifyIORef' concurrency (\x -> ((x-1),()))
203 writeIORef streamState (Closed cc)
204 writeIORef streamState (Closed cc)
204
205
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+3−3
@@ -1,5 +1,5 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
3
3
4module Network.Wai.Handler.Warp.HTTP2.Worker where
4module Network.Wai.Handler.Warp.HTTP2.Worker where
5
5
@@ -25,7 +25,7 @@ import Network.Wai.Internal (Response(..), ResponseReceived(..))
25type Responder = Stream -> Priority -> Request -> Response -> IO ResponseReceived
25type Responder = Stream -> Priority -> Request -> Response -> IO ResponseReceived
26
26
27response :: Context -> Responder
27response :: Context -> Responder
28−response Context{..} strm pri req rsp = do
28+response Context{outputQ} strm pri req rsp = do
29 case rsp of
29 case rsp of
30 ResponseStream _ _ strmbdy -> do
30 ResponseStream _ _ strmbdy -> do
31 -- fixme: spawn a new worker thread.
31 -- fixme: spawn a new worker thread.
@@ -57,7 +57,7 @@ data Break = Break deriving (Show, Typeable)
57instance Exception Break
57instance Exception Break
58
58
59worker :: Context -> S.Settings -> T.Manager -> Application -> Responder -> IO ()
59worker :: Context -> S.Settings -> T.Manager -> Application -> Responder -> IO ()
60−worker ctx@Context{..} set tm app responder = do
60+worker ctx@Context{inputQ,outputQ} set tm app responder = do
61 tid <- myThreadId
61 tid <- myThreadId
62 ref <- newIORef Nothing
62 ref <- newIORef Nothing
63 bracket (T.register tm (E.throwTo tid Break)) T.cancel $ \th ->
63 bracket (T.register tm (E.throwTo tid Break)) T.cancel $ \th ->