module Freckle.App.Bugsnag
( Settings
, HasBugsnagSettings (..)
, notifyBugsnag
, notifyBugsnagWith
, HasAppVersion (..)
, setAppVersion
, envParseBugsnagSettings
, MonadReader
, runReaderT
, module Network.Bugsnag
) where
import Freckle.App.Prelude
import qualified Control.Exception as Base (Exception)
import Control.Lens (Lens', view)
import Control.Monad.Catch (MonadMask)
import Control.Monad.Reader (runReaderT)
import Data.Bugsnag (App (..), Event (..), defaultApp)
import Data.Bugsnag.Settings (Settings (..), defaultSettings)
import Data.List (isInfixOf)
import Freckle.App.Async (async)
import Freckle.App.Bugsnag.CallStack (callStackBeforeNotify)
import Freckle.App.Bugsnag.HttpException (httpExceptionBeforeNotify)
import Freckle.App.Bugsnag.MetaData (metaDataAnnotationsBeforeNotify)
import Freckle.App.Bugsnag.SqlError (sqlErrorBeforeNotify)
import qualified Freckle.App.Env as Env
import Network.Bugsnag hiding (notifyBugsnag, notifyBugsnagWith)
import qualified Network.Bugsnag as Bugsnag
import Yesod.Core.Lens (envL, siteL)
import Yesod.Core.Types (HandlerData)
class HasAppVersion env where
appVersionL :: Lens' env Text
instance HasAppVersion site => HasAppVersion (HandlerData child site) where
appVersionL :: Lens' (HandlerData child site) Text
appVersionL = forall child site.
Lens' (HandlerData child site) (RunHandlerEnv child site)
envL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall child site. Lens' (RunHandlerEnv child site) site
siteL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasAppVersion env => Lens' env Text
appVersionL
setAppVersion :: Text -> BeforeNotify
setAppVersion :: Text -> BeforeNotify
setAppVersion Text
version = (Event -> Event) -> BeforeNotify
updateEvent forall a b. (a -> b) -> a -> b
$ \Event
event ->
Event
event
{ event_app :: Maybe App
event_app = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ App -> App
updateApp forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe App
defaultApp forall a b. (a -> b) -> a -> b
$ Event -> Maybe App
event_app Event
event
}
where
updateApp :: App -> App
updateApp App
app = App
app {app_version :: Maybe Text
app_version = forall a. a -> Maybe a
Just Text
version}
class HasBugsnagSettings env where
bugsnagSettingsL :: Lens' env Settings
instance HasBugsnagSettings Settings where
bugsnagSettingsL :: Lens' Settings Settings
bugsnagSettingsL = forall a. a -> a
id
instance HasBugsnagSettings site => HasBugsnagSettings (HandlerData child site) where
bugsnagSettingsL :: Lens' (HandlerData child site) Settings
bugsnagSettingsL = forall child site.
Lens' (HandlerData child site) (RunHandlerEnv child site)
envL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall child site. Lens' (RunHandlerEnv child site) site
siteL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasBugsnagSettings env => Lens' env Settings
bugsnagSettingsL
notifyBugsnag
:: ( MonadMask m
, MonadUnliftIO m
, MonadReader env m
, HasBugsnagSettings env
, Base.Exception e
)
=> e
-> m ()
notifyBugsnag :: forall (m :: * -> *) env e.
(MonadMask m, MonadUnliftIO m, MonadReader env m,
HasBugsnagSettings env, Exception e) =>
e -> m ()
notifyBugsnag = forall (m :: * -> *) env e.
(MonadMask m, MonadUnliftIO m, MonadReader env m,
HasBugsnagSettings env, Exception e) =>
BeforeNotify -> e -> m ()
notifyBugsnagWith forall a. Monoid a => a
mempty
notifyBugsnagWith
:: ( MonadMask m
, MonadUnliftIO m
, MonadReader env m
, HasBugsnagSettings env
, Base.Exception e
)
=> BeforeNotify
-> e
-> m ()
notifyBugsnagWith :: forall (m :: * -> *) env e.
(MonadMask m, MonadUnliftIO m, MonadReader env m,
HasBugsnagSettings env, Exception e) =>
BeforeNotify -> e -> m ()
notifyBugsnagWith BeforeNotify
f e
ex = do
Settings
settings <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBugsnagSettings env => Lens' env Settings
bugsnagSettingsL
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadMask m, MonadUnliftIO m) =>
m a -> m (Async a)
async 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 ()
Bugsnag.notifyBugsnagWith BeforeNotify
f Settings
settings e
ex
maskErrorHelpers :: BeforeNotify
maskErrorHelpers :: BeforeNotify
maskErrorHelpers = ([Char] -> Bool) -> BeforeNotify
setStackFramesInProjectByFile (forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
"Exceptions")
envParseBugsnagSettings :: Env.Parser Env.Error Settings
envParseBugsnagSettings :: Parser Error Settings
envParseBugsnagSettings =
Text -> Text -> Settings
build
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
AsUnset e =>
Reader e a -> [Char] -> Mod Var a -> Parser e a
Env.var forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty [Char]
"BUGSNAG_API_KEY" forall a. Monoid a => a
mempty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> [Char] -> Mod Var a -> Parser e a
Env.var forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty [Char]
"BUGSNAG_RELEASE_STAGE" (forall a. a -> Mod Var a
Env.def Text
"development")
where
build :: Text -> Text -> Settings
build Text
key Text
stage =
(Text -> Settings
defaultSettings Text
key)
{ settings_releaseStage :: Text
settings_releaseStage = Text
stage
, settings_beforeNotify :: BeforeNotify
settings_beforeNotify = BeforeNotify
globalBeforeNotify
}
globalBeforeNotify :: BeforeNotify
globalBeforeNotify :: BeforeNotify
globalBeforeNotify =
BeforeNotify
callStackBeforeNotify
forall a. Semigroup a => a -> a -> a
<> BeforeNotify
metaDataAnnotationsBeforeNotify
forall a. Semigroup a => a -> a -> a
<> BeforeNotify
sqlErrorBeforeNotify
forall a. Semigroup a => a -> a -> a
<> BeforeNotify
httpExceptionBeforeNotify
forall a. Semigroup a => a -> a -> a
<> BeforeNotify
maskErrorHelpers