From 2ac9a861e47d17195bccb9c2a0d0c6e28dbc0316 Mon Sep 17 00:00:00 2001 From: Igor Pashev Date: Wed, 23 Nov 2016 17:31:53 +0300 Subject: Differentiate exceptions --- src/Sproxy/Application.hs | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/src/Sproxy/Application.hs b/src/Sproxy/Application.hs index 5ce847c..8c3247c 100644 --- a/src/Sproxy/Application.hs +++ b/src/Sproxy/Application.hs @@ -8,7 +8,7 @@ module Sproxy.Application ( import Blaze.ByteString.Builder (toByteString) import Blaze.ByteString.Builder.ByteString (fromByteString) -import Control.Exception (SomeException, catch) +import Control.Exception (Exception, Handler(..), SomeException, catches, displayException) import Data.ByteString (ByteString) import Data.ByteString as BS (break, intercalate) import Data.Char (toLower) @@ -346,9 +346,20 @@ notFound msg req resp = do logException :: W.Middleware -logException app req resp = catch (app req resp) $ \e -> do - Log.error $ "500 Internal Error: " ++ show (e :: SomeException) ++ " on " ++ showReq req - resp $ W.responseLBS internalServerError500 [] "Internal Error" +logException app req resp = + catches (app req resp) [ + Handler internalError + ] + where + internalError :: SomeException -> IO W.ResponseReceived + internalError = response internalServerError500 + + response :: Exception e => Status -> e -> IO W.ResponseReceived + response st e = do + Log.error $ show (statusCode st) ++ " " ++ unpack (statusMessage st) + ++ ": " ++ displayException e ++ " on " ++ showReq req + resp $ W.responseLBS st [(hContentType, "text/plain")] (fromStrict $ statusMessage st) + get :: W.Middleware -- cgit v1.2.3