905456d · typeable/wai

git.iko.soy/typeable/wai

handling errors correctly.

commit905456d349b02bf220676992ab390ee07ef65474 authorKazu Yamamoto <kazu@iij.ad.jp> dateFri 17 Jul 2015, 12:19 (11 years ago) parent9479cc2

5 files changed+29−24

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+9−9 warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+10−5 warp/Network/Wai/Handler/Warp/HTTP2/Types.hs−5 warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+5−4 warp/Network/Wai/Handler/Warp/Recv.hs+5−1

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

@@ -2,13 +2,13 @@

22{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}

33{-# LANGUAGE BangPatterns #-}

44{-# LANGUAGE CPP #-}

5+{-# LANGUAGE PatternGuards #-}

67module Network.Wai.Handler.Warp.HTTP2.Receiver (frameReceiver) where

89#if __GLASGOW_HASKELL__ < 709

910import Control.Applicative

1011#endif

11−import Control.Concurrent (takeMVar)

1212import Control.Concurrent.STM

1313import qualified Control.Exception as E

1414import Control.Monad (when, unless, void)

@@ -27,8 +27,7 @@ import Network.Wai.Handler.Warp.Types

2727----------------------------------------------------------------

2828

2929frameReceiver :: Context -> MkReq -> (BufSize -> IO ByteString) -> IO ()

30−frameReceiver ctx mkreq recvN =

31− E.handle sendGoaway loop `E.finally` takeMVar wait

30+frameReceiver ctx mkreq recvN = loop `E.catch` sendGoaway

3231 where

3332 Context{ http2settings

3433 , streamTable

@@ -37,12 +36,13 @@ frameReceiver ctx mkreq recvN =

3736 , currentStreamId

3837 , inputQ

3938 , outputQ

40− , wait} = ctx

41− sendGoaway (ConnectionError err msg) = do

42− csid <- readIORef currentStreamId

43− let frame = goawayFrame csid err msg

44− enqueue outputQ (OGoaway frame) highestPriority

45− sendGoaway _ = return ()

39+ } = ctx

40+ sendGoaway e

41+ | Just (ConnectionError err msg) <- E.fromException e = do

42+ csid <- readIORef currentStreamId

43+ let frame = goawayFrame csid err msg

44+ enqueue outputQ (OGoaway frame) highestPriority

45+ | otherwise = return ()

4646

4747 sendReset err sid = do

4848 let frame = resetFrame err sid

warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+10−5

@@ -7,7 +7,7 @@ module Network.Wai.Handler.Warp.HTTP2.Sender (frameSender) where

77#if __GLASGOW_HASKELL__ < 709

88import Control.Applicative

99#endif

10−import Control.Concurrent (putMVar, forkIO)

10+import Control.Concurrent (forkIO)

1111import Control.Concurrent.STM

1212import qualified Control.Exception as E

1313import Control.Monad (void, unless)

@@ -68,19 +68,24 @@ checkWindowSize connWindow strmWindow outQ out pri body = do

6868 body (min cw sw)

6969

7070frameSender :: Context -> Connection -> InternalInfo -> S.Settings -> IO ()

71−frameSender ctx@Context{outputQ,connectionWindow,wait}

71+frameSender ctx@Context{outputQ,connectionWindow}

7272 conn@Connection{connWriteBuffer,connBufferSize,connSendAll}

73− ii settings = do

74− connSendAll initialFrame

75− loop `E.finally` putMVar wait ()

73+ ii settings = go `E.catch` ignore

7674 where

7775 initialSettings = [(SettingsMaxConcurrentStreams,recommendedConcurrency)]

7876 initialFrame = settingsFrame id initialSettings

7977 bufHeaderPayload = connWriteBuffer `plusPtr` frameHeaderLength

8078 headerPayloadLim = connBufferSize - frameHeaderLength

8179

80+ go = do

81+ connSendAll initialFrame

82+ loop

83+

8284 loop = dequeue outputQ >>= \(out, pri) -> switch out pri

8385

86+ ignore :: E.SomeException -> IO ()

87+ ignore _ = return ()

88+

8489 switch OFinish _ = return ()

8590 switch (OGoaway frame) _ = connSendAll frame

8691 switch (OFrame frame) _ = do

warp/Network/Wai/Handler/Warp/HTTP2/Types.hs−5

@@ -7,7 +7,6 @@ import Blaze.ByteString.Builder (Builder)

77#if __GLASGOW_HASKELL__ < 709

88import Control.Applicative ((<$>),(<*>))

99#endif

10−import Control.Concurrent

1110import Control.Concurrent.STM

1211import Control.Exception (SomeException)

1312import Control.Monad (void)

@@ -100,9 +99,6 @@ data Context = Context {

10099 , outputQ :: PriorityTree Output

101100 , encodeDynamicTable :: IORef DynamicTable

102101 , decodeDynamicTable :: IORef DynamicTable

103− -- | This is used to synchronization of sender and receiver

104− -- when the HTTP/2 connection is terminated.

105− , wait :: MVar ()

106102 , connectionWindow :: TVar WindowSize

107103 }

108104

@@ -118,7 +114,6 @@ newContext = Context <$> newIORef defaultSettings

118114 <*> newPriorityTree

119115 <*> (newDynamicTableForEncoding defaultDynamicTableSize >>= newIORef)

120116 <*> (newDynamicTableForDecoding defaultDynamicTableSize >>= newIORef)

121− <*> newEmptyMVar

122117 <*> newTVarIO defaultInitialWindowSize

123118

124119clearContext :: Context -> IO ()

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

@@ -6,7 +6,8 @@ module Network.Wai.Handler.Warp.HTTP2.Worker where

77import Control.Concurrent

88import Control.Concurrent.STM

9−import Control.Exception as E

9+import Control.Exception (Exception, SomeException(..), AsyncException(..))

10+import qualified Control.Exception as E

1011import Control.Monad (void, when)

1112import Data.Typeable

1213import qualified Network.HTTP.Types as H

@@ -63,7 +64,7 @@ worker ctx@Context{inputQ,outputQ} set tm app responder = do

6364 tid <- myThreadId

6465 ref <- newIORef Nothing

6566 let setup = T.register tm $ E.throwTo tid Break

66− bracket setup T.cancel $ go ref

67+ E.bracket setup T.cancel $ go ref

6768 where

6869 go ref th = do

6970 ex <- E.try $ do

@@ -76,11 +77,11 @@ worker ctx@Context{inputQ,outputQ} set tm app responder = do

7677 cont <- case ex of

7778 Right ResponseReceived -> return True

7879 Left e@(SomeException _)

79− | Just Break <- fromException e -> do

80+ | Just Break <- E.fromException e -> do

8081 cleanup ref Nothing

8182 return True

8283 -- killed by the sender

83− | Just ThreadKilled <- fromException e -> do

84+ | Just ThreadKilled <- E.fromException e -> do

8485 cleanup ref Nothing

8586 return False

8687 | otherwise -> do

warp/Network/Wai/Handler/Warp/Recv.hs+5−1

@@ -12,6 +12,7 @@ module Network.Wai.Handler.Warp.Recv (

1212#if __GLASGOW_HASKELL__ < 709

1313import Control.Applicative ((<$>))

1414#endif

15+import qualified Control.Exception as E

1516import qualified Data.ByteString as BS

1617import Data.ByteString.Internal (ByteString(..))

1718import Data.Word (Word8)

@@ -50,11 +51,14 @@ makePlainReceiveN s bs0 = do

5051 return $ receiveN ref (receive s pool) (receiveBuf s)

5152

5253receiveN :: IORef ByteString -> Recv -> RecvBuf -> BufSize -> IO ByteString

53−receiveN ref recv recvBuf size = do

54+receiveN ref recv recvBuf size = E.handle handler $ do

5455 cached <- readIORef ref

5556 (bs, leftover) <- spell cached size recv recvBuf

5657 writeIORef ref leftover

5758 return bs

59+ where

60+ handler :: E.SomeException -> IO ByteString

61+ handler _ = return ""

5862

5963----------------------------------------------------------------

6064