c2241ce · typeable/wai

git.iko.soy/typeable/wai

cleaning up onException and onExceptionResponse.

Exporting defaultOnException and defaultOnExceptionResponse. defaultOnExceptionResponse sends 400 or 500.

commitc2241cec44c35c5923b2af88eff8d627b0702a89 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 17 Jun 2015, 17:05 (11 years ago) parent02c4883

2 files changed+21−13

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp.hs+7−5 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/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+-- | Default implementation of 'settingsOnExceptionResponse'

149+-- for the debugging purpose. 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