{-# LANGUAGE AllowAmbiguousTypes #-}

-- | A 'yesodMiddleware' that notifies Bugsnag of exceptions
--
-- 'yesodMiddleware' is the only way to handle things as actual exceptions. The
-- alternative, using 'errorHandler', means you would only ever see  an
-- "InternalError Text" value.
--
-- The main downside to this middleware is that short-circuit responses also
-- come through the middleware as exceptions, and must be filtered. Unless of
-- course you want to notify Bugsnag of 404s and such.
--
module Network.Bugsnag.Yesod
    ( bugsnagYesodMiddleware
    , bugsnagYesodMiddlewareWith
    ) where

import Prelude

import Control.Exception.Annotated (AnnotatedException)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Bugsnag.Settings
import Data.Maybe (isJust)
import Network.Bugsnag
import Network.Bugsnag.Wai
import qualified Network.Wai as Wai
import UnliftIO.Exception
    (Exception, SomeException, fromException, withException)
import Yesod.Core (forkHandler, getsYesod, waiRequest)
import Yesod.Core.Types (HandlerContents, HandlerFor)

bugsnagYesodMiddleware
    :: (app -> Settings) -> HandlerFor app a -> HandlerFor app a
bugsnagYesodMiddleware :: forall app a.
(app -> Settings) -> HandlerFor app a -> HandlerFor app a
bugsnagYesodMiddleware = forall app a.
(Request -> BeforeNotify)
-> (app -> Settings) -> HandlerFor app a -> HandlerFor app a
bugsnagYesodMiddlewareWith Request -> BeforeNotify
updateEventFromWaiRequest

bugsnagYesodMiddlewareWith
    :: (Wai.Request -> BeforeNotify)
    -> (app -> Settings)
    -> HandlerFor app a
    -> HandlerFor app a
bugsnagYesodMiddlewareWith :: forall app a.
(Request -> BeforeNotify)
-> (app -> Settings) -> HandlerFor app a -> HandlerFor app a
bugsnagYesodMiddlewareWith Request -> BeforeNotify
mkBeforeNotify app -> Settings
getSettings HandlerFor app a
handler = do
    Settings
settings <- forall (m :: * -> *) a.
MonadHandler m =>
(HandlerSite m -> a) -> m a
getsYesod app -> Settings
getSettings
    Request
request <- forall (m :: * -> *). MonadHandler m => m Request
waiRequest

    HandlerFor app a
handler forall (m :: * -> *) e a b.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m b) -> m a
`withException` \SomeException
ex ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SomeException -> Bool
isHandlerContents SomeException
ex)
            forall a b. (a -> b) -> a -> b
$ forall site.
(SomeException -> HandlerFor site ())
-> HandlerFor site () -> HandlerFor site ()
forkHandler (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            forall a b. (a -> b) -> a -> b
$ forall e. Exception e => BeforeNotify -> Settings -> e -> IO ()
notifyBugsnagWith (Request -> BeforeNotify
mkBeforeNotify Request
request) Settings
settings SomeException
ex

isHandlerContents :: SomeException -> Bool
isHandlerContents :: SomeException -> Bool
isHandlerContents SomeException
ex =
    forall e. Exception e => SomeException -> Bool
is @HandlerContents SomeException
ex Bool -> Bool -> Bool
|| forall e. Exception e => SomeException -> Bool
is @(AnnotatedException HandlerContents) SomeException
ex

is :: forall e . Exception e => SomeException -> Bool
is :: forall e. Exception e => SomeException -> Bool
is = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => SomeException -> Maybe e
fromException @e