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

import Prelude

import Control.Exception (SomeException, fromException, toException)
import qualified Control.Exception as Exception
import Control.Exception.Annotated (AnnotatedException)
import qualified Control.Exception.Annotated as Annotated
import Control.Monad (unless, (<=<))
import Data.Annotation (tryAnnotations)
import Data.Bugsnag
import Data.Bugsnag.Settings
import Data.Foldable (fold)
import Data.List.NonEmpty (nonEmpty)
import Network.Bugsnag.BeforeNotify
import Network.Bugsnag.Exception
import Network.Bugsnag.MetaData
import Network.HTTP.Client.TLS (getGlobalManager)

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

notifyBugsnagWith
  :: Exception.Exception e => BeforeNotify -> Settings -> e -> IO ()
notifyBugsnagWith :: forall e. Exception e => BeforeNotify -> Settings -> e -> IO ()
notifyBugsnagWith BeforeNotify
f Settings
settings = Settings -> Event -> IO ()
reportEvent Settings
settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => BeforeNotify -> e -> Event
buildEvent BeforeNotify
bn
 where
  bn :: BeforeNotify
bn = BeforeNotify
f 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Event -> [Exception]
event_exceptions Event
event) 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]
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> IO ()
settings_onNotifyException forall (f :: * -> *) a. Applicative f => a -> f a
pure Either HttpException ()
result

buildEvent :: Exception.Exception e => BeforeNotify -> e -> Event
buildEvent :: forall e. Exception e => BeforeNotify -> e -> Event
buildEvent BeforeNotify
bn e
e =
  forall e. Exception e => BeforeNotify -> e -> Event -> Event
runBeforeNotify BeforeNotify
bn e
e forall a b. (a -> b) -> a -> b
$
    Event
defaultEvent
      { event_exceptions :: [Exception]
event_exceptions = [Exception
ex]
      , event_metaData :: Maybe Object
event_metaData = MetaData -> Object
unMetaData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => e -> Maybe MetaData
metaDataFromException e
e
      }
 where
  ex :: Exception
ex = SomeException -> Exception
bugsnagExceptionFromSomeException forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> SomeException
Exception.toException e
e

metaDataFromException :: Exception.Exception e => e -> Maybe MetaData
metaDataFromException :: forall e. Exception e => e -> Maybe MetaData
metaDataFromException =
  forall e. AnnotatedException e -> Maybe MetaData
metaDataFromAnnotatedException
    forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (forall e. Exception e => SomeException -> Maybe e
fromException @(AnnotatedException SomeException) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toException)

metaDataFromAnnotatedException :: AnnotatedException e -> Maybe MetaData
metaDataFromAnnotatedException :: forall e. AnnotatedException e -> Maybe MetaData
metaDataFromAnnotatedException = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall exception. AnnotatedException exception -> [Annotation]
Annotated.annotations

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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exception -> Bool
ignoreException)
    forall a. Semigroup a => a -> a -> a
<> BeforeNotify
settings_beforeNotify
    forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty CodeIndex -> BeforeNotify
setStackFramesCode Maybe CodeIndex
settings_codeIndex
    forall a. Semigroup a => a -> a -> a
<> (Event -> Event) -> BeforeNotify
updateEvent Event -> Event
setApp
 where
  ignoreException :: Exception -> Bool
ignoreException Exception
e
    | Text
settings_releaseStage 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 =
          forall a. a -> Maybe a
Just 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 = forall a. a -> Maybe a
Just Text
settings_releaseStage
              }
      }