8ff3212 · typeable/wai

git.iko.soy/typeable/wai

using NamedFieldPuns according to #339.

commit8ff32128cab32963c235c3d4a2e6c5fbfa060c61 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 15 Jul 2015, 12:21 (11 years ago) parent02f4449

5 files changed+37−17

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+4−3 warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+9−1 warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+17−7 warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+4−3 warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+3−3

warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+4−3

@@ -1,4 +1,5 @@

1−{-# LANGUAGE RecordWildCards, OverloadedStrings #-}

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}

34module Network.Wai.Handler.Warp.HTTP2.HPACK where

@@ -20,7 +21,7 @@ import Network.Wai.Handler.Warp.Types

2021

2122hpackEncodeHeader :: Context -> InternalInfo -> S.Settings -> Response

2223 -> IO Builder

23−hpackEncodeHeader Context{..} ii settings rsp = do

24+hpackEncodeHeader Context{encodeDynamicTable} ii settings rsp = do

2425 hdr1 <- addServerAndDate hdr0

2526 let hdr2 = (":status", status) : map (first foldedCase) hdr1

2627 ehdrtbl <- readIORef encodeDynamicTable

@@ -39,7 +40,7 @@ hpackEncodeHeader Context{..} ii settings rsp = do

3940----------------------------------------------------------------

4041

4142hpackDecodeHeader :: HeaderBlockFragment -> Context -> IO HeaderList

42−hpackDecodeHeader hdrblk Context{..} = do

43+hpackDecodeHeader hdrblk Context{decodeDynamicTable} = do

4344 hdrtbl <- readIORef decodeDynamicTable

4445 (hdrtbl', hdr) <- decodeHeader hdrtbl hdrblk `E.onException` cleanup

4546 writeIORef decodeDynamicTable hdrtbl'

warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+9−1

@@ -28,7 +28,15 @@ import Network.Wai.Handler.Warp.Types

2828----------------------------------------------------------------

2929

3030frameReceiver :: 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 =

3240 E.handle sendGoaway loop `E.finally` takeMVar wait

3341 where

3442 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 #-}

22{-# LANGUAGE BangPatterns, CPP #-}

3+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}

45module Network.Wai.Handler.Warp.HTTP2.Sender (frameSender) where

@@ -37,7 +38,10 @@ import System.Posix.Types

3738----------------------------------------------------------------

3839

3940unlessClosed :: Context -> Connection -> Stream -> IO () -> IO ()

40−unlessClosed ctx Connection{..} strm@Stream{..} body = E.handle resetStream $ do

41+unlessClosed ctx

42+ Connection{connSendAll}

43+ strm@Stream{streamState,streamNumber}

44+ body = E.handle resetStream $ do

4145 state <- readIORef streamState

4246 unless (isClosed state) body

4347 where

@@ -64,7 +68,9 @@ checkWindowSize connWindow strmWindow outQ out pri body = do

6468 body (min cw sw)

6569

6670frameSender :: 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

6874 connSendAll initialFrame

6975 loop `E.finally` putMVar wait ()

7076 where

@@ -172,14 +178,16 @@ ResponseRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) Response

172178-}

173179

174180fillResponseBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> Response -> IO Next

175−fillResponseBodyGetNext Connection{..} _ off lim (ResponseBuilder _ _ bb) = do

181+fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}

182+ _ off lim (ResponseBuilder _ _ bb) = do

176183 let datBuf = connWriteBuffer `plusPtr` off

177184 room = min (connBufferSize - off) lim

178185 (len, signal) <- B.runBuilder bb datBuf room

179186 return $ nextForBuilder connWriteBuffer connBufferSize len signal

180187

181188#ifdef WINDOWS

182−fillResponseBodyGetNext Connection{..} _ off lim (ResponseFile _ _ path mpart) = do

189+fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}

190+ _ off lim (ResponseFile _ _ path mpart) = do

183191 let datBuf = connWriteBuffer `plusPtr` off

184192 room = min (connBufferSize - off) lim

185193 (start, bytes) <- fileStartEnd path mpart

@@ -190,7 +198,8 @@ fillResponseBodyGetNext Connection{..} _ off lim (ResponseFile _ _ path mpart) =

190198 let bytes' = bytes - fromIntegral len

191199 return $ nextForFile len connWriteBuffer connBufferSize h bytes' (return ())

192200#else

193−fillResponseBodyGetNext Connection{..} ii off lim (ResponseFile _ _ path mpart) = do

201+fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}

202+ ii off lim (ResponseFile _ _ path mpart) = do

194203 let Just fdcache = fdCacher ii

195204 (fd, refresh) <- getFd fdcache path

196205 let datBuf = connWriteBuffer `plusPtr` off

@@ -214,7 +223,8 @@ fileStartEnd _ (Just part) =

214223----------------------------------------------------------------

215224

216225fillStreamBodyGetNext :: 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

218228 let datBuf = connWriteBuffer `plusPtr` off

219229 room = min (connBufferSize - off) lim

220230 (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 #-}

34module Network.Wai.Handler.Warp.HTTP2.Types where

@@ -193,12 +194,12 @@ newStream sid win = Stream sid <$> newIORef Idle

193194----------------------------------------------------------------

194195

195196opened :: Context -> Stream -> IO ()

196−opened Context{..} Stream{..} = do

197+opened Context{concurrency} Stream{streamState} = do

197198 atomicModifyIORef' concurrency (\x -> ((x+1),()))

198199 writeIORef streamState (Open JustOpened)

199200

200201closed :: Context -> Stream -> ClosedCode -> IO ()

201−closed Context{..} Stream{..} cc = do

202+closed Context{concurrency} Stream{streamState} cc = do

202203 atomicModifyIORef' concurrency (\x -> ((x-1),()))

203204 writeIORef streamState (Closed cc)

204205

warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+3−3

@@ -1,5 +1,5 @@

11{-# LANGUAGE DeriveDataTypeable #-}

2−{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}

44module Network.Wai.Handler.Warp.HTTP2.Worker where

@@ -25,7 +25,7 @@ import Network.Wai.Internal (Response(..), ResponseReceived(..))

2525type Responder = Stream -> Priority -> Request -> Response -> IO ResponseReceived

2626

2727response :: Context -> Responder

28−response Context{..} strm pri req rsp = do

28+response Context{outputQ} strm pri req rsp = do

2929 case rsp of

3030 ResponseStream _ _ strmbdy -> do

3131 -- fixme: spawn a new worker thread.

@@ -57,7 +57,7 @@ data Break = Break deriving (Show, Typeable)

5757instance Exception Break

5858

5959worker :: 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

6161 tid <- myThreadId

6262 ref <- newIORef Nothing

6363 bracket (T.register tm (E.throwTo tid Break)) T.cancel $ \th ->