module Network.Bugsnag.Yesod
( bugsnagYesodMiddleware
, bugsnagYesodMiddlewareWith
) where
import Prelude
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Bugsnag.Settings
import Network.Bugsnag
import Network.Bugsnag.Wai
import qualified Network.Wai as Wai
import UnliftIO.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 :: (app -> Settings) -> HandlerFor app a -> HandlerFor app a
bugsnagYesodMiddleware = (Request -> BeforeNotify)
-> (app -> Settings) -> HandlerFor app a -> HandlerFor app a
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 :: (Request -> BeforeNotify)
-> (app -> Settings) -> HandlerFor app a -> HandlerFor app a
bugsnagYesodMiddlewareWith Request -> BeforeNotify
mkBeforeNotify app -> Settings
getSettings HandlerFor app a
handler = do
Settings
settings <- (HandlerSite (HandlerFor app) -> Settings)
-> HandlerFor app Settings
forall (m :: * -> *) a.
MonadHandler m =>
(HandlerSite m -> a) -> m a
getsYesod app -> Settings
HandlerSite (HandlerFor app) -> Settings
getSettings
Request
request <- HandlerFor app Request
forall (m :: * -> *). MonadHandler m => m Request
waiRequest
HandlerFor app a
handler HandlerFor app a
-> (SomeException -> HandlerFor app ()) -> HandlerFor app a
forall (m :: * -> *) e a b.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m b) -> m a
`withException` \SomeException
ex ->
Bool -> HandlerFor app () -> HandlerFor app ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SomeException -> Bool
isHandlerContents SomeException
ex)
(HandlerFor app () -> HandlerFor app ())
-> HandlerFor app () -> HandlerFor app ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> HandlerFor app ())
-> HandlerFor app () -> HandlerFor app ()
forall site.
(SomeException -> HandlerFor site ())
-> HandlerFor site () -> HandlerFor site ()
forkHandler (HandlerFor app () -> SomeException -> HandlerFor app ()
forall a b. a -> b -> a
const (HandlerFor app () -> SomeException -> HandlerFor app ())
-> HandlerFor app () -> SomeException -> HandlerFor app ()
forall a b. (a -> b) -> a -> b
$ () -> HandlerFor app ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
(HandlerFor app () -> HandlerFor app ())
-> HandlerFor app () -> HandlerFor app ()
forall a b. (a -> b) -> a -> b
$ IO () -> HandlerFor app ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO () -> HandlerFor app ()) -> IO () -> HandlerFor app ()
forall a b. (a -> b) -> a -> b
$ BeforeNotify -> Settings -> SomeException -> IO ()
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 = case (SomeException -> Maybe HandlerContents
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex :: Maybe HandlerContents) of
Just HandlerContents
_ -> Bool
True
Maybe HandlerContents
Nothing -> Bool
False