{-# LANGUAGE AllowAmbiguousTypes #-}
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