git.iko.soy/typeable/wai
on master help sign in
cleaning up onException and onExceptionResponse.
c2241ceKazu Yamamoto
warp/Network/Wai/Handler/Warp.hs+7−5
compare with master
unifiedsplit
@@ -81,9 +81,12 @@ module Network.Wai.Handler.Warp (
81 , settingsFdCacheDuration
81 , settingsFdCacheDuration
82 , settingsBeforeMainLoop
82 , settingsBeforeMainLoop
83 , settingsNoParsePath
83 , settingsNoParsePath
84− -- ** Debugging
84+ -- ** Exception handler
85− , exceptionResponseForDebug
85+ , defaultOnException
86 , defaultShouldDisplayException
86 , defaultShouldDisplayException
87+ -- ** Exception response handler
88+ , defaultOnExceptionResponse
89+ , exceptionResponseForDebug
87 -- * Data types
90 -- * Data types
88 , Transport (..)
91 , Transport (..)
89 , HostPreference (..)
92 , HostPreference (..)
@@ -157,8 +160,7 @@ setHost :: HostPreference -> Settings -> Settings
157setHost x y = y { settingsHost = x }
160setHost x y = y { settingsHost = x }
158
161
159-- | What to do with exceptions thrown by either the application or server.
162-- | What to do with exceptions thrown by either the application or server.
160−-- Default: ignore server-generated exceptions (see 'InvalidRequest') and print
163+-- Default: 'defaultOnException'
161−-- application-generated exceptions to stderr.
162--
164--
163-- Since 2.1.0
165-- Since 2.1.0
164setOnException :: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
166setOnException :: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
@@ -166,7 +168,7 @@ setOnException x y = y { settingsOnException = x }
166
168
167-- | A function to create a `Response` when an exception occurs.
169-- | A function to create a `Response` when an exception occurs.
168--
170--
169−-- Default: 500, text/plain, \"Something went wrong\"
171+-- Default: 'defaultOnExceptionResponse'
170--
172--
171-- Since 2.1.0
173-- Since 2.1.0
172setOnExceptionResponse :: (SomeException -> Response) -> Settings -> Settings
174setOnExceptionResponse :: (SomeException -> Response) -> Settings -> Settings
warp/Network/Wai/Handler/Warp/Settings.hs+14−8
@@ -102,8 +102,8 @@ defaultSettings :: Settings
102defaultSettings = Settings
102defaultSettings = Settings
103 { settingsPort = 3000
103 { settingsPort = 3000
104 , settingsHost = "*4"
104 , settingsHost = "*4"
105− , settingsOnException = defaultExceptionHandler
105+ , settingsOnException = defaultOnException
106− , settingsOnExceptionResponse = defaultExceptionResponse
106+ , settingsOnExceptionResponse = defaultOnExceptionResponse
107 , settingsOnOpen = const $ return True
107 , settingsOnOpen = const $ return True
108 , settingsOnClose = const $ return ()
108 , settingsOnClose = const $ return ()
109 , settingsTimeout = 30
109 , settingsTimeout = 30
@@ -118,7 +118,7 @@ defaultSettings = Settings
118 , settingsProxyProtocol = ProxyProtocolNone
118 , settingsProxyProtocol = ProxyProtocolNone
119 }
119 }
120
120
121−-- | Apply the logic provided by 'defaultExceptionHandler' to determine if an
121+-- | Apply the logic provided by 'defaultOnException' to determine if an
122-- exception should be shown or not. The goal is to hide exceptions which occur
122-- exception should be shown or not. The goal is to hide exceptions which occur
123-- under the normal course of the web server running.
123-- under the normal course of the web server running.
124--
124--
@@ -132,15 +132,21 @@ defaultShouldDisplayException se
132 | Just TimeoutThread <- fromException se = False
132 | Just TimeoutThread <- fromException se = False
133 | otherwise = True
133 | otherwise = True
134
134
135+-- | Printing an exception to standard error
136+-- if `defaultShouldDisplayException` returns `True`.
135−defaultExceptionHandler :: Maybe Request -> SomeException -> IO ()
137+defaultOnException :: Maybe Request -> SomeException -> IO ()
136−defaultExceptionHandler _ e =
138+defaultOnException _ e =
137 when (defaultShouldDisplayException e)
139 when (defaultShouldDisplayException e)
138 $ TIO.hPutStrLn stderr $ T.pack $ show e
140 $ TIO.hPutStrLn stderr $ T.pack $ show e
139
141
142+-- | Sending 400 for bad requests. Sending 500 for internal server errors.
140−defaultExceptionResponse :: SomeException -> Response
143+defaultOnExceptionResponse :: SomeException -> Response
144+defaultOnExceptionResponse e
145+ | Just (_ :: InvalidRequest) <- fromException e = responseLBS H.badRequest400 [(H.hContentType, "text/plain; charset=utf-8")] "Bad Request"
141−defaultExceptionResponse _ = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] "Something went wrong"
146+ | otherwise = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] "Something went wrong"
142
147
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.
144exceptionResponseForDebug :: SomeException -> Response
150exceptionResponseForDebug :: SomeException -> Response
145exceptionResponseForDebug e = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] (TLE.encodeUtf8 $ TL.pack $ "Exception: " ++ show e)
151exceptionResponseForDebug e = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] (TLE.encodeUtf8 $ TL.pack $ "Exception: " ++ show e)
146
152