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

import Prelude

import Control.Exception (SomeException)
import Control.Monad (when)
import Data.Maybe (isJust)
import Network.Bugsnag.App
import Network.Bugsnag.BeforeNotify
import Network.Bugsnag.CodeIndex
import Network.Bugsnag.Event
import Network.Bugsnag.Exception
import Network.Bugsnag.Report
import Network.Bugsnag.Reporter
import Network.Bugsnag.Settings
import Network.Bugsnag.StackFrame

-- | Notify Bugsnag of a single exception
notifyBugsnag :: BugsnagSettings -> SomeException -> IO ()
notifyBugsnag :: BugsnagSettings -> SomeException -> IO ()
notifyBugsnag = BeforeNotify -> BugsnagSettings -> SomeException -> IO ()
notifyBugsnagWith BeforeNotify
forall a. a -> a
id

-- | Notify Bugsnag of a single exception, modifying the event
--
-- This is used to (e.g.) change severity for a specific error. Note that the
-- given function runs after any configured @'bsBeforeNotify'@, or changes
-- caused by other aspects of settings (e.g. grouping hash).
--
notifyBugsnagWith :: BeforeNotify -> BugsnagSettings -> SomeException -> IO ()
notifyBugsnagWith :: BeforeNotify -> BugsnagSettings -> SomeException -> IO ()
notifyBugsnagWith BeforeNotify
f BugsnagSettings
settings SomeException
ex = do
    let event :: BugsnagEvent
event =
            BeforeNotify
f
                BeforeNotify
-> (BugsnagException -> BugsnagEvent)
-> BugsnagException
-> BugsnagEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BugsnagSettings -> BeforeNotify
bsBeforeNotify BugsnagSettings
settings
                BeforeNotify
-> (BugsnagException -> BugsnagEvent)
-> BugsnagException
-> BugsnagEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CodeIndex -> BeforeNotify
modifyStackFrames (BugsnagSettings -> Maybe CodeIndex
bsCodeIndex BugsnagSettings
settings)
                BeforeNotify
-> (BugsnagException -> BugsnagEvent)
-> BugsnagException
-> BugsnagEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BugsnagSettings -> BeforeNotify
createApp BugsnagSettings
settings
                BeforeNotify
-> (BugsnagException -> BugsnagEvent)
-> BugsnagException
-> BugsnagEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BugsnagException -> BugsnagEvent
bugsnagEvent
                (BugsnagException -> BugsnagEvent)
-> BugsnagException -> BugsnagEvent
forall a b. (a -> b) -> a -> b
$ SomeException -> BugsnagException
bugsnagExceptionFromSomeException SomeException
ex

        manager :: Manager
manager = BugsnagSettings -> Manager
bsHttpManager BugsnagSettings
settings
        apiKey :: BugsnagApiKey
apiKey = BugsnagSettings -> BugsnagApiKey
bsApiKey BugsnagSettings
settings
        report :: BugsnagReport
report = [BugsnagEvent] -> BugsnagReport
bugsnagReport [BugsnagEvent
event]

    -- N.B. all notify functions should go through here. We need to maintain
    -- this as the single point where (e.g.) should-notify is checked,
    -- before-notify is applied, stack-frame filtering, etc.
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BugsnagSettings -> BugsnagEvent -> Bool
bugsnagShouldNotify BugsnagSettings
settings BugsnagEvent
event)
        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Manager -> BugsnagApiKey -> BugsnagReport -> IO ()
reportError Manager
manager BugsnagApiKey
apiKey BugsnagReport
report

-- |
--
-- If we have a @'CodeIndex'@ set the Code and then set InProject based on if we
-- found any. Otherwise we just assume everything is InProject.
--
modifyStackFrames :: Maybe CodeIndex -> BeforeNotify
modifyStackFrames :: Maybe CodeIndex -> BeforeNotify
modifyStackFrames Maybe CodeIndex
Nothing = (FilePath -> Bool) -> BeforeNotify
setStackFramesInProject ((FilePath -> Bool) -> BeforeNotify)
-> (FilePath -> Bool) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> Bool
forall a b. a -> b -> a
const Bool
True
modifyStackFrames (Just CodeIndex
index) =
    (BugsnagStackFrame -> Maybe BugsnagCode)
-> (Maybe BugsnagCode -> Bool) -> BeforeNotify
forall a. (BugsnagStackFrame -> a) -> (a -> Bool) -> BeforeNotify
setStackFramesInProjectBy BugsnagStackFrame -> Maybe BugsnagCode
bsfCode Maybe BugsnagCode -> Bool
forall a. Maybe a -> Bool
isJust BeforeNotify -> BeforeNotify -> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeIndex -> BeforeNotify
setStackFramesCode CodeIndex
index

-- |
--
-- N.B. safe to clobber because we're only used on a fresh event.
--
createApp :: BugsnagSettings -> BeforeNotify
createApp :: BugsnagSettings -> BeforeNotify
createApp BugsnagSettings
settings BugsnagEvent
event = BugsnagEvent
event
    { beApp :: Maybe BugsnagApp
beApp = BugsnagApp -> Maybe BugsnagApp
forall a. a -> Maybe a
Just (BugsnagApp -> Maybe BugsnagApp) -> BugsnagApp -> Maybe BugsnagApp
forall a b. (a -> b) -> a -> b
$ BugsnagApp
bugsnagApp
        { baVersion :: Maybe Text
baVersion = BugsnagSettings -> Maybe Text
bsAppVersion BugsnagSettings
settings
        , baReleaseStage :: Maybe BugsnagReleaseStage
baReleaseStage = BugsnagReleaseStage -> Maybe BugsnagReleaseStage
forall a. a -> Maybe a
Just (BugsnagReleaseStage -> Maybe BugsnagReleaseStage)
-> BugsnagReleaseStage -> Maybe BugsnagReleaseStage
forall a b. (a -> b) -> a -> b
$ BugsnagSettings -> BugsnagReleaseStage
bsReleaseStage BugsnagSettings
settings
        }
    }