Add logExceptionsMiddleware

We currently log all handler exceptions through the `errorHandler`
member of the `Yesod` type-class. This is not ideal because it only has
access to an `InternalError Text` value, in which any exception has
already been turned into its string representation. This means we get an
ugly message like `"AnnotatedException {...}"` and aren't able to
actually construct a structured log.

We should stop doing that, and recover that logging by adding a Yesod
middleware that catches, logs, and re-throws all exceptions instead.

Then it can be handled as an actual (annotated) exception, and produce a
nice, structured log message (i.e. with `error.stack`). That's what this
middleware does. It's also what necessitated adding `withException`.

library/Freckle/App/Yesod.hs

@@ -2,6 +2,7 @@
 module Freckle.App.Yesod
   ( respondQueryCanceled
   , respondQueryCanceledHeaders
+  , logExceptionsMiddleware
   ) where
 
 import Freckle.App.Prelude
@@ -11,12 +12,15 @@ import Database.PostgreSQL.Simple (SqlError (..))
 import Freckle.App.Exception
   ( AnnotatedException (..)
   , annotatedExceptionMessageFrom
+  , fromException
+  , withException
   )
 import Freckle.App.Stats (HasStatsClient)
 import qualified Freckle.App.Stats as Stats
 import Network.HTTP.Types (ResponseHeaders, status503)
 import qualified Network.Wai as W
 import Yesod.Core.Handler (HandlerFor, sendWaiResponse)
+import Yesod.Core.Types (HandlerContents)
 
 -- | Catch 'SqlError' when queries are canceled due to timeout and respond 503
 --
@@ -37,6 +41,16 @@ respondQueryCanceledHeaders headers handler =
     Stats.increment "query_canceled"
     sendWaiResponse $ W.responseLBS status503 headers "Query canceled"
 
+logExceptionsMiddleware :: (MonadUnliftIO m, MonadLogger m) => m a -> m a
+logExceptionsMiddleware f =
+  f `withException` \ex ->
+    unless (isHandlerContents ex) $
+      logErrorNS "yesod" $
+        annotatedExceptionMessageFrom (const "Handler exception") ex
+
+isHandlerContents :: AnnotatedException SomeException -> Bool
+isHandlerContents = isJust . fromException @HandlerContents . exception
+
 queryCanceled
   :: AnnotatedException SqlError -> Maybe (AnnotatedException SqlError)
 queryCanceled ex = ex <$ guard (sqlState (exception ex) == "57014")