@@ -1,7 +1,7 @@
11{-# LANGUAGE DeriveDataTypeable #-}
22{-# LANGUAGE OverloadedStrings #-}
33{-# LANGUAGE RecordWildCards #-}
4−module Servant.Server.Internal.ServantErr where
4+module Servant.Server.Internal.ServerError where
55
66import Control.Exception
77 (Exception)
@@ -13,16 +13,18 @@ import qualified Network.HTTP.Types as HTTP
1313import Network.Wai
1414 (Response, responseLBS)
1515
16−data ServantErr = ServantErr { errHTTPCode :: Int
17− , errReasonPhrase :: String
18− , errBody :: LBS.ByteString
19− , errHeaders :: [HTTP.Header]
20− } deriving (Show, Eq, Read, Typeable)
16+data ServerError = ServerError
17+ { errHTTPCode :: Int
18+ , errReasonPhrase :: String
19+ , errBody :: LBS.ByteString
20+ , errHeaders :: [HTTP.Header]
21+ }
22+ deriving (Show, Eq, Read, Typeable)
2123
22−instance Exception ServantErr
24+instance Exception ServerError
2325
24−responseServantErr :: ServantErr -> Response
25−responseServantErr ServantErr{..} = responseLBS status errHeaders errBody
26+responseServerError :: ServerError -> Response
27+responseServerError ServerError{..} = responseLBS status errHeaders errBody
2628 where
2729 status = HTTP.mkStatus errHTTPCode (BS.pack errReasonPhrase)
2830
@@ -33,8 +35,8 @@ responseServantErr ServantErr{..} = responseLBS status errHeaders errBody
3335-- > failingHandler :: Handler ()
3436-- > failingHandler = throwError $ err300 { errBody = "I can't choose." }
3537--
36−err300 :: ServantErr
37−err300 = ServantErr { errHTTPCode = 300
38+err300 :: ServerError
39+err300 = ServerError { errHTTPCode = 300
3840 , errReasonPhrase = "Multiple Choices"
3941 , errBody = ""
4042 , errHeaders = []
@@ -47,8 +49,8 @@ err300 = ServantErr { errHTTPCode = 300
4749-- > failingHandler :: Handler ()
4850-- > failingHandler = throwError err301
4951--
50−err301 :: ServantErr
51−err301 = ServantErr { errHTTPCode = 301
52+err301 :: ServerError
53+err301 = ServerError { errHTTPCode = 301
5254 , errReasonPhrase = "Moved Permanently"
5355 , errBody = ""
5456 , errHeaders = []
@@ -61,8 +63,8 @@ err301 = ServantErr { errHTTPCode = 301
6163-- > failingHandler :: Handler ()
6264-- > failingHandler = throwError err302
6365--
64−err302 :: ServantErr
65−err302 = ServantErr { errHTTPCode = 302
66+err302 :: ServerError
67+err302 = ServerError { errHTTPCode = 302
6668 , errReasonPhrase = "Found"
6769 , errBody = ""
6870 , errHeaders = []
@@ -75,8 +77,8 @@ err302 = ServantErr { errHTTPCode = 302
7577-- > failingHandler :: Handler ()
7678-- > failingHandler = throwError err303
7779--
78−err303 :: ServantErr
79−err303 = ServantErr { errHTTPCode = 303
80+err303 :: ServerError
81+err303 = ServerError { errHTTPCode = 303
8082 , errReasonPhrase = "See Other"
8183 , errBody = ""
8284 , errHeaders = []
@@ -89,8 +91,8 @@ err303 = ServantErr { errHTTPCode = 303
8991-- > failingHandler :: Handler ()
9092-- > failingHandler = throwError err304
9193--
92−err304 :: ServantErr
93−err304 = ServantErr { errHTTPCode = 304
94+err304 :: ServerError
95+err304 = ServerError { errHTTPCode = 304
9496 , errReasonPhrase = "Not Modified"
9597 , errBody = ""
9698 , errHeaders = []
@@ -103,8 +105,8 @@ err304 = ServantErr { errHTTPCode = 304
103105-- > failingHandler :: Handler ()
104106-- > failingHandler = throwError err305
105107--
106−err305 :: ServantErr
107−err305 = ServantErr { errHTTPCode = 305
108+err305 :: ServerError
109+err305 = ServerError { errHTTPCode = 305
108110 , errReasonPhrase = "Use Proxy"
109111 , errBody = ""
110112 , errHeaders = []
@@ -117,8 +119,8 @@ err305 = ServantErr { errHTTPCode = 305
117119-- > failingHandler :: Handler ()
118120-- > failingHandler = throwError err307
119121--
120−err307 :: ServantErr
121−err307 = ServantErr { errHTTPCode = 307
122+err307 :: ServerError
123+err307 = ServerError { errHTTPCode = 307
122124 , errReasonPhrase = "Temporary Redirect"
123125 , errBody = ""
124126 , errHeaders = []
@@ -131,8 +133,8 @@ err307 = ServantErr { errHTTPCode = 307
131133-- > failingHandler :: Handler ()
132134-- > failingHandler = throwError $ err400 { errBody = "Your request makes no sense to me." }
133135--
134−err400 :: ServantErr
135−err400 = ServantErr { errHTTPCode = 400
136+err400 :: ServerError
137+err400 = ServerError { errHTTPCode = 400
136138 , errReasonPhrase = "Bad Request"
137139 , errBody = ""
138140 , errHeaders = []
@@ -145,8 +147,8 @@ err400 = ServantErr { errHTTPCode = 400
145147-- > failingHandler :: Handler ()
146148-- > failingHandler = throwError $ err401 { errBody = "Your credentials are invalid." }
147149--
148−err401 :: ServantErr
149−err401 = ServantErr { errHTTPCode = 401
150+err401 :: ServerError
151+err401 = ServerError { errHTTPCode = 401
150152 , errReasonPhrase = "Unauthorized"
151153 , errBody = ""
152154 , errHeaders = []
@@ -159,8 +161,8 @@ err401 = ServantErr { errHTTPCode = 401
159161-- > failingHandler :: Handler ()
160162-- > failingHandler = throwError $ err402 { errBody = "You have 0 credits. Please give me $$$." }
161163--
162−err402 :: ServantErr
163−err402 = ServantErr { errHTTPCode = 402
164+err402 :: ServerError
165+err402 = ServerError { errHTTPCode = 402
164166 , errReasonPhrase = "Payment Required"
165167 , errBody = ""
166168 , errHeaders = []
@@ -173,8 +175,8 @@ err402 = ServantErr { errHTTPCode = 402
173175-- > failingHandler :: Handler ()
174176-- > failingHandler = throwError $ err403 { errBody = "Please login first." }
175177--
176−err403 :: ServantErr
177−err403 = ServantErr { errHTTPCode = 403
178+err403 :: ServerError
179+err403 = ServerError { errHTTPCode = 403
178180 , errReasonPhrase = "Forbidden"
179181 , errBody = ""
180182 , errHeaders = []
@@ -187,8 +189,8 @@ err403 = ServantErr { errHTTPCode = 403
187189-- > failingHandler :: Handler ()
188190-- > failingHandler = throwError $ err404 { errBody = "(╯°□°)╯︵ ┻━┻)." }
189191--
190−err404 :: ServantErr
191−err404 = ServantErr { errHTTPCode = 404
192+err404 :: ServerError
193+err404 = ServerError { errHTTPCode = 404
192194 , errReasonPhrase = "Not Found"
193195 , errBody = ""
194196 , errHeaders = []
@@ -201,8 +203,8 @@ err404 = ServantErr { errHTTPCode = 404
201203-- > failingHandler :: Handler ()
202204-- > failingHandler = throwError $ err405 { errBody = "Your account privileges does not allow for this. Please pay $$$." }
203205--
204−err405 :: ServantErr
205−err405 = ServantErr { errHTTPCode = 405
206+err405 :: ServerError
207+err405 = ServerError { errHTTPCode = 405
206208 , errReasonPhrase = "Method Not Allowed"
207209 , errBody = ""
208210 , errHeaders = []
@@ -215,8 +217,8 @@ err405 = ServantErr { errHTTPCode = 405
215217-- > failingHandler :: Handler ()
216218-- > failingHandler = throwError err406
217219--
218−err406 :: ServantErr
219−err406 = ServantErr { errHTTPCode = 406
220+err406 :: ServerError
221+err406 = ServerError { errHTTPCode = 406
220222 , errReasonPhrase = "Not Acceptable"
221223 , errBody = ""
222224 , errHeaders = []
@@ -229,8 +231,8 @@ err406 = ServantErr { errHTTPCode = 406
229231-- > failingHandler :: Handler ()
230232-- > failingHandler = throwError err407
231233--
232−err407 :: ServantErr
233−err407 = ServantErr { errHTTPCode = 407
234+err407 :: ServerError
235+err407 = ServerError { errHTTPCode = 407
234236 , errReasonPhrase = "Proxy Authentication Required"
235237 , errBody = ""
236238 , errHeaders = []
@@ -243,8 +245,8 @@ err407 = ServantErr { errHTTPCode = 407
243245-- > failingHandler :: Handler ()
244246-- > failingHandler = throwError $ err409 { errBody = "Transaction conflicts with 59879cb56c7c159231eeacdd503d755f7e835f74" }
245247--
246−err409 :: ServantErr
247−err409 = ServantErr { errHTTPCode = 409
248+err409 :: ServerError
249+err409 = ServerError { errHTTPCode = 409
248250 , errReasonPhrase = "Conflict"
249251 , errBody = ""
250252 , errHeaders = []
@@ -257,8 +259,8 @@ err409 = ServantErr { errHTTPCode = 409
257259-- > failingHandler :: Handler ()
258260-- > failingHandler = throwError $ err410 { errBody = "I know it was here at some point, but.. I blame bad luck." }
259261--
260−err410 :: ServantErr
261−err410 = ServantErr { errHTTPCode = 410
262+err410 :: ServerError
263+err410 = ServerError { errHTTPCode = 410
262264 , errReasonPhrase = "Gone"
263265 , errBody = ""
264266 , errHeaders = []
@@ -271,8 +273,8 @@ err410 = ServantErr { errHTTPCode = 410
271273-- > failingHandler :: Handler ()
272274-- > failingHandler = throwError err411
273275--
274−err411 :: ServantErr
275−err411 = ServantErr { errHTTPCode = 411
276+err411 :: ServerError
277+err411 = ServerError { errHTTPCode = 411
276278 , errReasonPhrase = "Length Required"
277279 , errBody = ""
278280 , errHeaders = []
@@ -285,8 +287,8 @@ err411 = ServantErr { errHTTPCode = 411
285287-- > failingHandler :: Handler ()
286288-- > failingHandler = throwError $ err412 { errBody = "Precondition fail: x < 42 && y > 57" }
287289--
288−err412 :: ServantErr
289−err412 = ServantErr { errHTTPCode = 412
290+err412 :: ServerError
291+err412 = ServerError { errHTTPCode = 412
290292 , errReasonPhrase = "Precondition Failed"
291293 , errBody = ""
292294 , errHeaders = []
@@ -299,8 +301,8 @@ err412 = ServantErr { errHTTPCode = 412
299301-- > failingHandler :: Handler ()
300302-- > failingHandler = throwError $ err413 { errBody = "Request exceeded 64k." }
301303--
302−err413 :: ServantErr
303−err413 = ServantErr { errHTTPCode = 413
304+err413 :: ServerError
305+err413 = ServerError { errHTTPCode = 413
304306 , errReasonPhrase = "Request Entity Too Large"
305307 , errBody = ""
306308 , errHeaders = []
@@ -313,8 +315,8 @@ err413 = ServantErr { errHTTPCode = 413
313315-- > failingHandler :: Handler ()
314316-- > failingHandler = throwError $ err414 { errBody = "Maximum length is 64." }
315317--
316−err414 :: ServantErr
317−err414 = ServantErr { errHTTPCode = 414
318+err414 :: ServerError
319+err414 = ServerError { errHTTPCode = 414
318320 , errReasonPhrase = "Request-URI Too Large"
319321 , errBody = ""
320322 , errHeaders = []
@@ -327,8 +329,8 @@ err414 = ServantErr { errHTTPCode = 414
327329-- > failingHandler :: Handler ()
328330-- > failingHandler = throwError $ err415 { errBody = "Supported media types: gif, png" }
329331--
330−err415 :: ServantErr
331−err415 = ServantErr { errHTTPCode = 415
332+err415 :: ServerError
333+err415 = ServerError { errHTTPCode = 415
332334 , errReasonPhrase = "Unsupported Media Type"
333335 , errBody = ""
334336 , errHeaders = []
@@ -341,8 +343,8 @@ err415 = ServantErr { errHTTPCode = 415
341343-- > failingHandler :: Handler ()
342344-- > failingHandler = throwError $ err416 { errBody = "Valid range is [0, 424242]." }
343345--
344−err416 :: ServantErr
345−err416 = ServantErr { errHTTPCode = 416
346+err416 :: ServerError
347+err416 = ServerError { errHTTPCode = 416
346348 , errReasonPhrase = "Request range not satisfiable"
347349 , errBody = ""
348350 , errHeaders = []
@@ -355,8 +357,8 @@ err416 = ServantErr { errHTTPCode = 416
355357-- > failingHandler :: Handler ()
356358-- > failingHandler = throwError $ err417 { errBody = "I found a quux in the request. This isn't going to work." }
357359--
358−err417 :: ServantErr
359−err417 = ServantErr { errHTTPCode = 417
360+err417 :: ServerError
361+err417 = ServerError { errHTTPCode = 417
360362 , errReasonPhrase = "Expectation Failed"
361363 , errBody = ""
362364 , errHeaders = []
@@ -369,8 +371,8 @@ err417 = ServantErr { errHTTPCode = 417
369371-- > failingHandler :: Handler ()
370372-- > failingHandler = throwError $ err418 { errBody = "Apologies, this is not a webserver but a teapot." }
371373--
372−err418 :: ServantErr
373−err418 = ServantErr { errHTTPCode = 418
374+err418 :: ServerError
375+err418 = ServerError { errHTTPCode = 418
374376 , errReasonPhrase = "I'm a teapot"
375377 , errBody = ""
376378 , errHeaders = []
@@ -383,8 +385,8 @@ err418 = ServantErr { errHTTPCode = 418
383385-- > failingHandler :: Handler ()
384386-- > failingHandler = throwError $ err422 { errBody = "I understood your request, but can't process it." }
385387--
386−err422 :: ServantErr
387−err422 = ServantErr { errHTTPCode = 422
388+err422 :: ServerError
389+err422 = ServerError { errHTTPCode = 422
388390 , errReasonPhrase = "Unprocessable Entity"
389391 , errBody = ""
390392 , errHeaders = []
@@ -397,8 +399,8 @@ err422 = ServantErr { errHTTPCode = 422
397399-- > failingHandler :: Handler ()
398400-- > failingHandler = throwError $ err500 { errBody = "Exception in module A.B.C:55. Have a great day!" }
399401--
400−err500 :: ServantErr
401−err500 = ServantErr { errHTTPCode = 500
402+err500 :: ServerError
403+err500 = ServerError { errHTTPCode = 500
402404 , errReasonPhrase = "Internal Server Error"
403405 , errBody = ""
404406 , errHeaders = []
@@ -411,8 +413,8 @@ err500 = ServantErr { errHTTPCode = 500
411413-- > failingHandler :: Handler ()
412414-- > failingHandler = throwError $ err501 { errBody = "/v1/foo is not supported with quux in the request." }
413415--
414−err501 :: ServantErr
415−err501 = ServantErr { errHTTPCode = 501
416+err501 :: ServerError
417+err501 = ServerError { errHTTPCode = 501
416418 , errReasonPhrase = "Not Implemented"
417419 , errBody = ""
418420 , errHeaders = []
@@ -425,8 +427,8 @@ err501 = ServantErr { errHTTPCode = 501
425427-- > failingHandler :: Handler ()
426428-- > failingHandler = throwError $ err502 { errBody = "Tried gateway foo, bar, and baz. None responded." }
427429--
428−err502 :: ServantErr
429−err502 = ServantErr { errHTTPCode = 502
430+err502 :: ServerError
431+err502 = ServerError { errHTTPCode = 502
430432 , errReasonPhrase = "Bad Gateway"
431433 , errBody = ""
432434 , errHeaders = []
@@ -439,8 +441,8 @@ err502 = ServantErr { errHTTPCode = 502
439441-- > failingHandler :: Handler ()
440442-- > failingHandler = throwError $ err503 { errBody = "We're rewriting in PHP." }
441443--
442−err503 :: ServantErr
443−err503 = ServantErr { errHTTPCode = 503
444+err503 :: ServerError
445+err503 = ServerError { errHTTPCode = 503
444446 , errReasonPhrase = "Service Unavailable"
445447 , errBody = ""
446448 , errHeaders = []
@@ -453,8 +455,8 @@ err503 = ServantErr { errHTTPCode = 503
453455-- > failingHandler :: Handler ()
454456-- > failingHandler = throwError $ err504 { errBody = "Backend foobar did not respond in 5 seconds." }
455457--
456−err504 :: ServantErr
457−err504 = ServantErr { errHTTPCode = 504
458+err504 :: ServerError
459+err504 = ServerError { errHTTPCode = 504
458460 , errReasonPhrase = "Gateway Time-out"
459461 , errBody = ""
460462 , errHeaders = []
@@ -467,8 +469,8 @@ err504 = ServantErr { errHTTPCode = 504
467469-- > failingHandler :: Handler ()
468470-- > failingHandler = throwError $ err505 { errBody = "I support HTTP/4.0 only." }
469471--
470−err505 :: ServantErr
471−err505 = ServantErr { errHTTPCode = 505
472+err505 :: ServerError
473+err505 = ServerError { errHTTPCode = 505
472474 , errReasonPhrase = "HTTP Version not supported"
473475 , errBody = ""
474476 , errHeaders = []