Servant print exceptions

Question

How can I print description of all exceptions? It would be great to toggle the debug/release format.

Standard Servant installation only shows 500/Something went wrong which isn't really helpful

HTTP/1.1 500 Internal Server Error

Something went wrong

Upd:

I get the following error reporting my first handler:

Server.hs:152:31: error:
    • No instance for (MonadCatch
                         ((:<|>) (Servant.Handler (Map.Map String String))))
        arising from a use of ‘catch’
    • In the expression:
        server `catch` (\ e -> handleExceptions (e :: SomeException))
      In an equation for ‘serverWithExceptionsHandled’:
          serverWithExceptionsHandled
            = server `catch` (\ e -> handleExceptions (e :: SomeException))

The handler itself:

type API = "ping" :> Get '[JSON] (Map.Map String String) ...

ping :: Servant.Handler (Map.Map String String)
ping = return $ Map.fromList [("reply", "pong")] 

Update:

server :: Server API
server = ping
    :<|> signup
    :<|> singin
    :<|> account
    :<|> getSessions


serverWithExceptionsHandled = server `catch` (\e -> handleExceptions (e :: SomeException))

-- | print to console and then rethrow
handleExceptions :: (MonadIO m, MonadThrow m, Exception e) => e -> m b
handleExceptions e = do
  liftIO $ print e
  throwM e

app :: Application
app = serveWithContext api ctx serverWithExceptionsHandled
        where ctx = checkBasicAuth :. EmptyContext

Answer 1

All server code runs in Handler which has a MonadCatch instance as well as a MonadThrow instance. So you can warp your server code with exception handlers like so:

handled :: Server SomeRoute
handled = server1 `catch` (\e -> handleExceptions (e :: SomeException))

type API = SomeRoute :<|> (other routes)

combined :: Server API
combined = handled :<|> (server code for other routes)

app :: Application
app = serve @API Proxy combined

where handleExceptions is your exception handler, for example:

-- | print to console and then rethrow
handleExceptions e = do
  liftIO $ print e
  throwM e

---

more examples:

ping' = ping `catch` (\e -> handleExceptions (e :: SomeException))

server :: Server API
server = ping'
    :<|> signup
    :<|> singin
    :<|> account
    :<|> getSessions