module Network.Wai.Middleware.Catch where
import Prelude hiding (catch, concat)
import Data.ByteString (concat)
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy.Char8 (pack)
import Control.Exception (Exception(..), SomeException)
import Control.Exception.Lifted (Handler(..), catches)
import Network.Wai (Application, Middleware, responseLBS, Request(..))
import Network.HTTP.Types (status500)
data ResponseHandler = forall e . Exception e =>
ResponseHandler (e -> Application)
protect :: [ResponseHandler]
-> Middleware
protect handlers app req =
catches (app req) (wrapHandlers handlers)
where
wrapHandlers = fmap (\(ResponseHandler f) -> Handler (`f` req))
mkHandler :: forall e . Exception e =>
(e -> Application)
-> ResponseHandler
mkHandler = ResponseHandler
defHandler :: ResponseHandler
defHandler = mkHandler (\(e::SomeException) req ->
return $ responseLBS status500 [] $ pack $
show e ++ " : " ++ dumpRequest req)
where
dumpRequest req = unpack $ concat [requestMethod req, " ",
rawPathInfo req, rawQueryString req]