module Network.Bugsnag.Notify
    ( notifyBugsnag
    , notifyBugsnagWith
    ) where

import Prelude

import qualified Control.Exception as Exception
import Control.Monad (unless)
import Data.Bugsnag
import Data.Bugsnag.Settings
import Network.Bugsnag.BeforeNotify
import Network.Bugsnag.Exception
import Network.HTTP.Client.TLS (getGlobalManager)

notifyBugsnag :: Exception.Exception e => Settings -> e -> IO ()
notifyBugsnag :: Settings -> e -> IO ()
notifyBugsnag = BeforeNotify -> Settings -> e -> IO ()
forall e. Exception e => BeforeNotify -> Settings -> e -> IO ()
notifyBugsnagWith BeforeNotify
forall a. Monoid a => a
mempty

notifyBugsnagWith
    :: Exception.Exception e => BeforeNotify -> Settings -> e -> IO ()
notifyBugsnagWith :: BeforeNotify -> Settings -> e -> IO ()
notifyBugsnagWith BeforeNotify
f Settings
settings = Settings -> Event -> IO ()
reportEvent Settings
settings (Event -> IO ()) -> (e -> Event) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeforeNotify -> e -> Event
forall e. Exception e => BeforeNotify -> e -> Event
buildEvent BeforeNotify
bn
    where bn :: BeforeNotify
bn = BeforeNotify
f BeforeNotify -> BeforeNotify -> BeforeNotify
forall a. Semigroup a => a -> a -> a
<> Settings -> BeforeNotify
globalBeforeNotify Settings
settings

reportEvent :: Settings -> Event -> IO ()
reportEvent :: Settings -> Event -> IO ()
reportEvent Settings {[Text]
Maybe Text
Maybe CodeIndex
Text
ApiKey
BeforeNotify
Exception -> Bool
HttpException -> IO ()
settings_codeIndex :: Settings -> Maybe CodeIndex
settings_onNotifyException :: Settings -> HttpException -> IO ()
settings_ignoreException :: Settings -> Exception -> Bool
settings_beforeNotify :: Settings -> BeforeNotify
settings_enabledReleaseStages :: Settings -> [Text]
settings_releaseStage :: Settings -> Text
settings_appVersion :: Settings -> Maybe Text
settings_apiKey :: Settings -> ApiKey
settings_codeIndex :: Maybe CodeIndex
settings_onNotifyException :: HttpException -> IO ()
settings_ignoreException :: Exception -> Bool
settings_beforeNotify :: BeforeNotify
settings_enabledReleaseStages :: [Text]
settings_releaseStage :: Text
settings_appVersion :: Maybe Text
settings_apiKey :: ApiKey
..} Event
event = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Exception] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Exception] -> Bool) -> [Exception] -> Bool
forall a b. (a -> b) -> a -> b
$ Event -> [Exception]
event_exceptions Event
event) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Manager
m <- IO Manager
getGlobalManager
    Either HttpException ()
result <- Manager -> ApiKey -> [Event] -> IO (Either HttpException ())
sendEvents Manager
m ApiKey
settings_apiKey [Event
event]
    (HttpException -> IO ())
-> (() -> IO ()) -> Either HttpException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> IO ()
settings_onNotifyException () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either HttpException ()
result

buildEvent :: Exception.Exception e => BeforeNotify -> e -> Event
buildEvent :: BeforeNotify -> e -> Event
buildEvent BeforeNotify
bn e
e = BeforeNotify -> e -> Event -> Event
forall e. Exception e => BeforeNotify -> e -> Event -> Event
runBeforeNotify BeforeNotify
bn e
e
    (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ Event
defaultEvent { event_exceptions :: [Exception]
event_exceptions = [Exception
ex] }
    where ex :: Exception
ex = SomeException -> Exception
bugsnagExceptionFromSomeException (SomeException -> Exception) -> SomeException -> Exception
forall a b. (a -> b) -> a -> b
$ e -> SomeException
forall e. Exception e => e -> SomeException
Exception.toException e
e

globalBeforeNotify :: Settings -> BeforeNotify
globalBeforeNotify :: Settings -> BeforeNotify
globalBeforeNotify Settings {[Text]
Maybe Text
Maybe CodeIndex
Text
ApiKey
BeforeNotify
Exception -> Bool
HttpException -> IO ()
settings_codeIndex :: Maybe CodeIndex
settings_onNotifyException :: HttpException -> IO ()
settings_ignoreException :: Exception -> Bool
settings_beforeNotify :: BeforeNotify
settings_enabledReleaseStages :: [Text]
settings_releaseStage :: Text
settings_appVersion :: Maybe Text
settings_apiKey :: ApiKey
settings_codeIndex :: Settings -> Maybe CodeIndex
settings_onNotifyException :: Settings -> HttpException -> IO ()
settings_ignoreException :: Settings -> Exception -> Bool
settings_beforeNotify :: Settings -> BeforeNotify
settings_enabledReleaseStages :: Settings -> [Text]
settings_releaseStage :: Settings -> Text
settings_appVersion :: Settings -> Maybe Text
settings_apiKey :: Settings -> ApiKey
..} =
    (Exception -> Bool) -> BeforeNotify
filterExceptions (Bool -> Bool
not (Bool -> Bool) -> (Exception -> Bool) -> Exception -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exception -> Bool
ignoreException)
        BeforeNotify -> BeforeNotify -> BeforeNotify
forall a. Semigroup a => a -> a -> a
<> BeforeNotify
settings_beforeNotify
        BeforeNotify -> BeforeNotify -> BeforeNotify
forall a. Semigroup a => a -> a -> a
<> BeforeNotify
-> (CodeIndex -> BeforeNotify) -> Maybe CodeIndex -> BeforeNotify
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BeforeNotify
forall a. Monoid a => a
mempty CodeIndex -> BeforeNotify
setStackFramesCode Maybe CodeIndex
settings_codeIndex
        BeforeNotify -> BeforeNotify -> BeforeNotify
forall a. Semigroup a => a -> a -> a
<> (Event -> Event) -> BeforeNotify
updateEvent Event -> Event
setApp
  where
    ignoreException :: Exception -> Bool
ignoreException Exception
e
        | Text
settings_releaseStage Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
settings_enabledReleaseStages = Bool
True
        | Bool
otherwise = Exception -> Bool
settings_ignoreException Exception
e

    setApp :: Event -> Event
setApp Event
event = Event
event
        { event_app :: Maybe App
event_app = App -> Maybe App
forall a. a -> Maybe a
Just (App -> Maybe App) -> App -> Maybe App
forall a b. (a -> b) -> a -> b
$ App
defaultApp
            { app_version :: Maybe Text
app_version = Maybe Text
settings_appVersion
            , app_releaseStage :: Maybe Text
app_releaseStage = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
settings_releaseStage
            }
        }