[CORE-7914] Log an unhandled exception or a user abort before the computation ends

log-base/src/Log/Monad.hs

@@ -46,19 +46,25 @@ instance MonadReader r m => MonadReader r (LogT m) where
     ask   = lift ask
     local = mapLogT . local
 
--- | Run a 'LogT' computation.
+-- | Run a 'LogT' computation and log any uncaught exceptions.
 --
 -- Note that in the case of asynchronous/bulk loggers 'runLogT'
 -- doesn't guarantee that all messages are actually written to the log
 -- once it finishes. Use 'withPGLogger' or 'withElasticSearchLogger'
 -- for that.
-runLogT :: Text     -- ^ Application component name to use.
+runLogT :: (MonadBaseControl IO m)
+        => Text     -- ^ Application component name to use.
         -> Logger   -- ^ The logging back-end to use.
         -> LogLevel -- ^ The maximum log level allowed to be logged.
                     --   Only messages less or equal than this level with be logged.
         -> LogT m a -- ^ The 'LogT' computation to run.
         -> m a
-runLogT component logger maxLogLevel m = runReaderT (unLogT m) LoggerEnv {
+runLogT component logger maxLogLevel m = runReaderT
+  (unLogT $ liftedCatch m (\(SomeException e) -> do
+      logAttention "Uncaught exception" $ object ["error" .= show e]
+      E.throw e)
+  )
+  LoggerEnv {
   leLogger = logger
 , leComponent = component
 , leDomain = []
@@ -67,6 +73,16 @@ runLogT component logger maxLogLevel m = runReaderT (unLogT m) LoggerEnv {
 } -- We can't do synchronisation here, since 'runLogT' can be invoked
   -- quite often from the application (e.g. on every request).
 
+-- Generalized version of catch taken from `lifted-base`
+liftedCatch :: (MonadBaseControl IO m, Exception e)
+      => m a       -- ^ The computation to run
+      -> (e -> m a) -- ^ Handler to invoke if an exception is raised
+      -> m a
+liftedCatch a handler = control $ \runInIO ->
+  E.catch
+    (runInIO a)
+    (\e -> runInIO $ handler e)
+
 -- | Transform the computation inside a 'LogT'.
 mapLogT :: (m a -> n b) -> LogT m a -> LogT n b
 mapLogT f = LogT . mapReaderT f . unLogT