module Network.Bugsnag.BeforeNotify
  ( BeforeNotify
  , beforeNotify
  , runBeforeNotify

    -- * Modifying the underlying Exceptions
  , updateExceptions
  , filterExceptions
  , updateStackFrames
  , filterStackFrames
  , setStackFramesCode
  , setStackFramesInProject
  , setStackFramesInProjectByFile
  , setStackFramesInProjectBy

    -- * Modifying the Event
  , updateEvent
  , updateEventFromOriginalException
  , setGroupingHash
  , setGroupingHashBy
  , setDevice
  , setContext
  , setRequest
  , setWarningSeverity
  , setErrorSeverity
  , setInfoSeverity
  ) where

import Prelude

import qualified Control.Exception as Exception
import qualified Control.Exception.Annotated as Annotated
import Data.Bugsnag
import Data.Maybe (isJust)
import Data.Text (Text, unpack)
import Network.Bugsnag.CodeIndex
import Network.Bugsnag.StackFrame

-- | A function from 'Event' to 'Event' that is applied before notifying
--
-- The wrapped function also accepts the original exception, for cases in which
-- that's useful -- but it's often not. Most 'BeforeNotify's use 'updateEvent',
-- which discards it.
--
-- 'BeforeNotify' implements 'Semigroup' and 'Monoid', which means the /do
-- nothing/ 'BeforeNotify' is 'mempty' and two 'BeforeNotify's @doThis@ then
-- @doThat@ can be implemented as @doThat <> doThis@.
newtype BeforeNotify = BeforeNotify
  { BeforeNotify -> forall e. Exception e => e -> Event -> Event
_unBeforeNotify :: forall e. Exception.Exception e => e -> Event -> Event
  }

instance Semigroup BeforeNotify where
  BeforeNotify forall e. Exception e => e -> Event -> Event
f <> :: BeforeNotify -> BeforeNotify -> BeforeNotify
<> BeforeNotify forall e. Exception e => e -> Event -> Event
g = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
BeforeNotify ((forall e. Exception e => e -> Event -> Event) -> BeforeNotify)
-> (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \e
e -> e -> Event -> Event
forall e. Exception e => e -> Event -> Event
f e
e (Event -> Event) -> (Event -> Event) -> Event -> Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Event -> Event
forall e. Exception e => e -> Event -> Event
g e
e

instance Monoid BeforeNotify where
  mempty :: BeforeNotify
mempty = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
BeforeNotify ((forall e. Exception e => e -> Event -> Event) -> BeforeNotify)
-> (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ (Event -> Event) -> e -> Event -> Event
forall a b. a -> b -> a
const Event -> Event
forall a. a -> a
id

beforeNotify
  :: (forall e. Exception.Exception e => e -> Event -> Event)
  -> BeforeNotify
beforeNotify :: (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
beforeNotify = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
BeforeNotify

runBeforeNotify :: Exception.Exception e => BeforeNotify -> e -> Event -> Event
runBeforeNotify :: forall e. Exception e => BeforeNotify -> e -> Event -> Event
runBeforeNotify (BeforeNotify forall e. Exception e => e -> Event -> Event
f) = e -> Event -> Event
forall e. Exception e => e -> Event -> Event
f

updateExceptions :: (Exception -> Exception) -> BeforeNotify
updateExceptions :: (Exception -> Exception) -> BeforeNotify
updateExceptions Exception -> Exception
f = (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$
  \Event
event -> Event
event {event_exceptions = map f $ event_exceptions event}

filterExceptions :: (Exception -> Bool) -> BeforeNotify
filterExceptions :: (Exception -> Bool) -> BeforeNotify
filterExceptions Exception -> Bool
p = (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event ->
  Event
event {event_exceptions = filter p $ event_exceptions event}

updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify
updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify
updateStackFrames StackFrame -> StackFrame
f = (Exception -> Exception) -> BeforeNotify
updateExceptions ((Exception -> Exception) -> BeforeNotify)
-> (Exception -> Exception) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$
  \Exception
e -> Exception
e {exception_stacktrace = map f $ exception_stacktrace e}

filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify
filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify
filterStackFrames StackFrame -> Bool
p = (Exception -> Exception) -> BeforeNotify
updateExceptions ((Exception -> Exception) -> BeforeNotify)
-> (Exception -> Exception) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$
  \Exception
e -> Exception
e {exception_stacktrace = filter p $ exception_stacktrace e}

setStackFramesCode :: CodeIndex -> BeforeNotify
setStackFramesCode :: CodeIndex -> BeforeNotify
setStackFramesCode =
  ((StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy (Maybe (HashMap Int Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (HashMap Int Text) -> Bool)
-> (StackFrame -> Maybe (HashMap Int Text)) -> StackFrame -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackFrame -> Maybe (HashMap Int Text)
stackFrame_code) BeforeNotify -> BeforeNotify -> BeforeNotify
forall a. Semigroup a => a -> a -> a
<>)
    (BeforeNotify -> BeforeNotify)
-> (CodeIndex -> BeforeNotify) -> CodeIndex -> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StackFrame -> StackFrame) -> BeforeNotify
updateStackFrames
    ((StackFrame -> StackFrame) -> BeforeNotify)
-> (CodeIndex -> StackFrame -> StackFrame)
-> CodeIndex
-> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeIndex -> StackFrame -> StackFrame
attachBugsnagCode

setStackFramesInProject :: Bool -> BeforeNotify
setStackFramesInProject :: Bool -> BeforeNotify
setStackFramesInProject = (StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy ((StackFrame -> Bool) -> BeforeNotify)
-> (Bool -> StackFrame -> Bool) -> Bool -> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> StackFrame -> Bool
forall a b. a -> b -> a
const

setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify
setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify
setStackFramesInProjectByFile FilePath -> Bool
f =
  (StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy ((StackFrame -> Bool) -> BeforeNotify)
-> (StackFrame -> Bool) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool
f (FilePath -> Bool)
-> (StackFrame -> FilePath) -> StackFrame -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> FilePath)
-> (StackFrame -> Text) -> StackFrame -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackFrame -> Text
stackFrame_file

setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy StackFrame -> Bool
f =
  (StackFrame -> StackFrame) -> BeforeNotify
updateStackFrames ((StackFrame -> StackFrame) -> BeforeNotify)
-> (StackFrame -> StackFrame) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \StackFrame
sf -> StackFrame
sf {stackFrame_inProject = Just $ f sf}

updateEvent :: (Event -> Event) -> BeforeNotify
updateEvent :: (Event -> Event) -> BeforeNotify
updateEvent Event -> Event
f = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
beforeNotify ((forall e. Exception e => e -> Event -> Event) -> BeforeNotify)
-> (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \e
_e Event
event -> Event -> Event
f Event
event

-- | Update the 'Event' based on the original exception
--
-- This allows updating the Event after casting to an exception type that this
-- library doesn't know about (e.g. @SqlError@). Because the result of your
-- function is itself a 'BeforeNotify', you can (and should) use other
-- helpers:
--
-- @
-- myBeforeNotify =
--     'defaultBeforeNotify'
--         <> 'updateEventFromOriginalException' asSqlError
--         <> 'updateEventFromOriginalException' asHttpError
--         <> -- ...
--
-- asSqlError :: SqlError -> BeforeNotify
-- asSqlError SqlError{..} =
--     'setGroupingHash' sqlErrorCode <> 'updateException' (\e -> e
--         { exception_errorClass = sqlErrorCode
--         , exception_message = Just sqlErrorMessage
--         })
-- @
--
-- If the cast fails, the event is unchanged.
--
-- The cast will match either @e@ or @'AnnotatedException' e@.
updateEventFromOriginalException
  :: forall e. Exception.Exception e => (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException :: forall e. Exception e => (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException e -> BeforeNotify
f = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
beforeNotify ((forall e. Exception e => e -> Event -> Event) -> BeforeNotify)
-> (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \e
e Event
event ->
  let bn :: BeforeNotify
bn =
        BeforeNotify
-> (AnnotatedException e -> BeforeNotify)
-> Maybe (AnnotatedException e)
-> BeforeNotify
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BeforeNotify
forall a. Monoid a => a
mempty (e -> BeforeNotify
f (e -> BeforeNotify)
-> (AnnotatedException e -> e)
-> AnnotatedException e
-> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedException e -> e
forall exception. AnnotatedException exception -> exception
Annotated.exception) (Maybe (AnnotatedException e) -> BeforeNotify)
-> Maybe (AnnotatedException e) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$
          SomeException -> Maybe (AnnotatedException e)
forall e. Exception e => SomeException -> Maybe e
Exception.fromException (SomeException -> Maybe (AnnotatedException e))
-> SomeException -> Maybe (AnnotatedException e)
forall a b. (a -> b) -> a -> b
$
            e -> SomeException
forall e. Exception e => e -> SomeException
Exception.toException e
e
  in  BeforeNotify -> e -> Event -> Event
forall e. Exception e => BeforeNotify -> e -> Event -> Event
runBeforeNotify BeforeNotify
bn e
e Event
event

setGroupingHash :: Text -> BeforeNotify
setGroupingHash :: Text -> BeforeNotify
setGroupingHash Text
hash = (Event -> Maybe Text) -> BeforeNotify
setGroupingHashBy ((Event -> Maybe Text) -> BeforeNotify)
-> (Event -> Maybe Text) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Event -> Maybe Text
forall a b. a -> b -> a
const (Maybe Text -> Event -> Maybe Text)
-> Maybe Text -> Event -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hash

setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify
setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify
setGroupingHashBy Event -> Maybe Text
f =
  (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event {event_groupingHash = f event}

-- | Set the Event's Context
setContext :: Text -> BeforeNotify
setContext :: Text -> BeforeNotify
setContext Text
context =
  (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event {event_context = Just context}

-- | Set the Event's Request
--
-- See 'bugsnagRequestFromWaiRequest'
setRequest :: Request -> BeforeNotify
setRequest :: Request -> BeforeNotify
setRequest Request
request =
  (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event {event_request = Just request}

-- | Set the Event's Device
--
-- See 'bugsnagDeviceFromWaiRequest'
setDevice :: Device -> BeforeNotify
setDevice :: Device -> BeforeNotify
setDevice Device
device = (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event {event_device = Just device}

-- | Set to 'ErrorSeverity'
setErrorSeverity :: BeforeNotify
setErrorSeverity :: BeforeNotify
setErrorSeverity = Severity -> BeforeNotify
setSeverity Severity
errorSeverity

-- | Set to 'WarningSeverity'
setWarningSeverity :: BeforeNotify
setWarningSeverity :: BeforeNotify
setWarningSeverity = Severity -> BeforeNotify
setSeverity Severity
warningSeverity

-- | Set to 'InfoSeverity'
setInfoSeverity :: BeforeNotify
setInfoSeverity :: BeforeNotify
setInfoSeverity = Severity -> BeforeNotify
setSeverity Severity
infoSeverity

setSeverity :: Severity -> BeforeNotify
setSeverity :: Severity -> BeforeNotify
setSeverity Severity
severity =
  (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event {event_severity = Just severity}