3a73a15 · typeable/wai

git.iko.soy/typeable/wai

Merge pull request #386 from yesodweb/exception-handling

Exception handling

commit3a73a157fa4849c8710efb9aad88d6b525721a57 authorMichael Snoyman <michael@snoyman.com> dateWed 17 Jun 2015, 13:07 (11 years ago) parentcd80cb6 90a0da4

4 files changed+23−17

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp.hs+7−5 warp/Network/Wai/Handler/Warp/Request.hs+1−1 warp/Network/Wai/Handler/Warp/Run.hs+1−3 warp/Network/Wai/Handler/Warp/Settings.hs+14−8

warp/Network/Wai/Handler/Warp.hs+7−5

@@ -81,9 +81,12 @@ module Network.Wai.Handler.Warp (

8181 , settingsFdCacheDuration

8282 , settingsBeforeMainLoop

8383 , settingsNoParsePath

84− -- ** Debugging

85− , exceptionResponseForDebug

84+ -- ** Exception handler

85+ , defaultOnException

8686 , defaultShouldDisplayException

87+ -- ** Exception response handler

88+ , defaultOnExceptionResponse

89+ , exceptionResponseForDebug

8790 -- * Data types

8891 , Transport (..)

8992 , HostPreference (..)

@@ -157,8 +160,7 @@ setHost :: HostPreference -> Settings -> Settings

157160setHost x y = y { settingsHost = x }

158161

159162-- | What to do with exceptions thrown by either the application or server.

160−-- Default: ignore server-generated exceptions (see 'InvalidRequest') and print

161−-- application-generated exceptions to stderr.

163+-- Default: 'defaultOnException'

162164--

163165-- Since 2.1.0

164166setOnException :: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings

@@ -166,7 +168,7 @@ setOnException x y = y { settingsOnException = x }

166168

167169-- | A function to create a `Response` when an exception occurs.

168170--

169−-- Default: 500, text/plain, \"Something went wrong\"

171+-- Default: 'defaultOnExceptionResponse'

170172--

171173-- Since 2.1.0

172174setOnExceptionResponse :: (SomeException -> Response) -> Settings -> Settings

warp/Network/Wai/Handler/Warp/Request.hs+1−1

@@ -98,7 +98,7 @@ headerLines :: Source -> IO [ByteString]

9898headerLines src = do

9999 bs <- readSource src

100100 if S.null bs

101− then throwIO $ NotEnoughLines []

101+ then throwIO $ ConnectionClosedByPeer

102102 else push src (THStatus 0 id id) bs

103103

104104----------------------------------------------------------------

warp/Network/Wai/Handler/Warp/Run.hs+1−3

@@ -179,9 +179,7 @@ runSettingsConnectionMakerSecure set getConnMaker app = do

179179 f

180180

181181onE :: Settings -> Maybe Request -> SomeException -> IO ()

182−onE set mreq e = case fromException e of

183− Just (NotEnoughLines []) -> return ()

184− _ -> settingsOnException set mreq e

182+onE set mreq e = settingsOnException set mreq e

185183

186184-- Note that there is a thorough discussion of the exception safety of the

187185-- following code at: https://github.com/yesodweb/wai/issues/146

warp/Network/Wai/Handler/Warp/Settings.hs+14−8

@@ -102,8 +102,8 @@ defaultSettings :: Settings

102102defaultSettings = Settings

103103 { settingsPort = 3000

104104 , settingsHost = "*4"

105− , settingsOnException = defaultExceptionHandler

106− , settingsOnExceptionResponse = defaultExceptionResponse

105+ , settingsOnException = defaultOnException

106+ , settingsOnExceptionResponse = defaultOnExceptionResponse

107107 , settingsOnOpen = const $ return True

108108 , settingsOnClose = const $ return ()

109109 , settingsTimeout = 30

@@ -118,7 +118,7 @@ defaultSettings = Settings

118118 , settingsProxyProtocol = ProxyProtocolNone

119119 }

120120

121−-- | Apply the logic provided by 'defaultExceptionHandler' to determine if an

121+-- | Apply the logic provided by 'defaultOnException' to determine if an

122122-- exception should be shown or not. The goal is to hide exceptions which occur

123123-- under the normal course of the web server running.

124124--

@@ -132,15 +132,21 @@ defaultShouldDisplayException se

132132 | Just TimeoutThread <- fromException se = False

133133 | otherwise = True

134134

135−defaultExceptionHandler :: Maybe Request -> SomeException -> IO ()

136−defaultExceptionHandler _ e =

135+-- | Printing an exception to standard error

136+-- if `defaultShouldDisplayException` returns `True`.

137+defaultOnException :: Maybe Request -> SomeException -> IO ()

138+defaultOnException _ e =

137139 when (defaultShouldDisplayException e)

138140 $ TIO.hPutStrLn stderr $ T.pack $ show e

139141

140−defaultExceptionResponse :: SomeException -> Response

141−defaultExceptionResponse _ = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] "Something went wrong"

142+-- | Sending 400 for bad requests. Sending 500 for internal server errors.

143+defaultOnExceptionResponse :: SomeException -> Response

144+defaultOnExceptionResponse e

145+ | Just (_ :: InvalidRequest) <- fromException e = responseLBS H.badRequest400 [(H.hContentType, "text/plain; charset=utf-8")] "Bad Request"

146+ | otherwise = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] "Something went wrong"

142147

143−-- | Default implementation of 'settingsOnExceptionResponse' for the debugging purpose. 500, text/plain, a showed exception.

148+-- | Exception handler for the debugging purpose.

149+-- 500, text/plain, a showed exception.

144150exceptionResponseForDebug :: SomeException -> Response

145151exceptionResponseForDebug e = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] (TLE.encodeUtf8 $ TL.pack $ "Exception: " ++ show e)

146152