module Network.Bugsnag.BeforeNotify
    ( BeforeNotify

    -- * Modifying the Exception
    , updateException
    , updateStackFrames
    , filterStackFrames
    , setStackFramesCode
    , setStackFramesInProject
    , setStackFramesInProjectBy
    , setGroupingHash
    , setGroupingHashBy

    -- * Modifying the Event
    , updateEventFromException
    , updateEventFromOriginalException
    , updateEventFromSession
    , updateEventFromWaiRequest
    , updateEventFromWaiRequestUnredacted

    -- * Modifying the Request
    , redactRequestHeaders

    -- * Simple setters
    , setDevice
    , setRequest
    , setStacktrace

    -- * Setting severity
    , setWarningSeverity
    , setErrorSeverity
    , setInfoSeverity
    ) where

import Prelude

import Control.Exception (Exception, fromException)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Network.Bugsnag.BugsnagRequestHeaders
import Network.Bugsnag.CodeIndex
import Network.Bugsnag.Device
import Network.Bugsnag.Event
import Network.Bugsnag.Exception
import Network.Bugsnag.Request
import Network.Bugsnag.Session
import Network.Bugsnag.Severity
import Network.Bugsnag.StackFrame
import Network.HTTP.Types.Header (HeaderName)
import Network.Wai (Request)

type BeforeNotify = BugsnagEvent -> BugsnagEvent

-- | Modify just the Exception part of an Event
--
-- This may be used to set more specific information for exception types in
-- scope in your application:
--
-- > notifyBugsnagWith (updateException forSqlError) settings ex
-- >
-- > forSqlError :: BugsnagException -> BugsnagException
-- > forSqlError ex =
-- >     case fromException =<< beOriginalException ex of
-- >         Just SqlError{..} -> ex
-- >             { beErrorClass = "SqlError-" <> sqlErrorCode
-- >             , beMessage = Just sqlErrorMessage
-- >             }
-- >         _ -> ex
--
updateException :: (BugsnagException -> BugsnagException) -> BeforeNotify
updateException :: (BugsnagException -> BugsnagException) -> BeforeNotify
updateException BugsnagException -> BugsnagException
f BugsnagEvent
event = BugsnagEvent
event { beException :: BugsnagException
beException = BugsnagException -> BugsnagException
f (BugsnagException -> BugsnagException)
-> BugsnagException -> BugsnagException
forall a b. (a -> b) -> a -> b
$ BugsnagEvent -> BugsnagException
beException BugsnagEvent
event }

-- | Apply a function to each @'BugsnagStackFrame'@ in the Exception
updateStackFrames :: (BugsnagStackFrame -> BugsnagStackFrame) -> BeforeNotify
updateStackFrames :: (BugsnagStackFrame -> BugsnagStackFrame) -> BeforeNotify
updateStackFrames BugsnagStackFrame -> BugsnagStackFrame
f =
    (BugsnagException -> BugsnagException) -> BeforeNotify
updateException ((BugsnagException -> BugsnagException) -> BeforeNotify)
-> (BugsnagException -> BugsnagException) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \BugsnagException
ex -> BugsnagException
ex { beStacktrace :: [BugsnagStackFrame]
beStacktrace = (BugsnagStackFrame -> BugsnagStackFrame)
-> [BugsnagStackFrame] -> [BugsnagStackFrame]
forall a b. (a -> b) -> [a] -> [b]
map BugsnagStackFrame -> BugsnagStackFrame
f ([BugsnagStackFrame] -> [BugsnagStackFrame])
-> [BugsnagStackFrame] -> [BugsnagStackFrame]
forall a b. (a -> b) -> a -> b
$ BugsnagException -> [BugsnagStackFrame]
beStacktrace BugsnagException
ex }

-- | Filter out StackFrames matching a predicate
filterStackFrames :: (BugsnagStackFrame -> Bool) -> BeforeNotify
filterStackFrames :: (BugsnagStackFrame -> Bool) -> BeforeNotify
filterStackFrames BugsnagStackFrame -> Bool
p =
    (BugsnagException -> BugsnagException) -> BeforeNotify
updateException ((BugsnagException -> BugsnagException) -> BeforeNotify)
-> (BugsnagException -> BugsnagException) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \BugsnagException
ex -> BugsnagException
ex { beStacktrace :: [BugsnagStackFrame]
beStacktrace = (BugsnagStackFrame -> Bool)
-> [BugsnagStackFrame] -> [BugsnagStackFrame]
forall a. (a -> Bool) -> [a] -> [a]
filter BugsnagStackFrame -> Bool
p ([BugsnagStackFrame] -> [BugsnagStackFrame])
-> [BugsnagStackFrame] -> [BugsnagStackFrame]
forall a b. (a -> b) -> a -> b
$ BugsnagException -> [BugsnagStackFrame]
beStacktrace BugsnagException
ex }

-- | Set @'bsfCode'@ using the given index
setStackFramesCode :: CodeIndex -> BeforeNotify
setStackFramesCode :: CodeIndex -> BeforeNotify
setStackFramesCode = (BugsnagStackFrame -> BugsnagStackFrame) -> BeforeNotify
updateStackFrames ((BugsnagStackFrame -> BugsnagStackFrame) -> BeforeNotify)
-> (CodeIndex -> BugsnagStackFrame -> BugsnagStackFrame)
-> CodeIndex
-> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeIndex -> BugsnagStackFrame -> BugsnagStackFrame
attachBugsnagCode

-- | Set @'bsIsInProject'@ using the given predicate, applied to the Filename
setStackFramesInProject :: (FilePath -> Bool) -> BeforeNotify
setStackFramesInProject :: (FilePath -> Bool) -> BeforeNotify
setStackFramesInProject = (BugsnagStackFrame -> FilePath)
-> (FilePath -> Bool) -> BeforeNotify
forall a. (BugsnagStackFrame -> a) -> (a -> Bool) -> BeforeNotify
setStackFramesInProjectBy BugsnagStackFrame -> FilePath
bsfFile

setStackFramesInProjectBy
    :: (BugsnagStackFrame -> a) -> (a -> Bool) -> BeforeNotify
setStackFramesInProjectBy :: (BugsnagStackFrame -> a) -> (a -> Bool) -> BeforeNotify
setStackFramesInProjectBy BugsnagStackFrame -> a
f a -> Bool
p =
    (BugsnagStackFrame -> BugsnagStackFrame) -> BeforeNotify
updateStackFrames ((BugsnagStackFrame -> BugsnagStackFrame) -> BeforeNotify)
-> (BugsnagStackFrame -> BugsnagStackFrame) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \BugsnagStackFrame
sf -> BugsnagStackFrame
sf { bsfInProject :: Maybe Bool
bsfInProject = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ a -> Bool
p (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ BugsnagStackFrame -> a
f BugsnagStackFrame
sf }

-- | Set @'beGroupingHash'@
setGroupingHash :: Text -> BeforeNotify
setGroupingHash :: Text -> BeforeNotify
setGroupingHash Text
hash = (BugsnagEvent -> Maybe Text) -> BeforeNotify
setGroupingHashBy ((BugsnagEvent -> Maybe Text) -> BeforeNotify)
-> (BugsnagEvent -> Maybe Text) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ Maybe Text -> BugsnagEvent -> Maybe Text
forall a b. a -> b -> a
const (Maybe Text -> BugsnagEvent -> Maybe Text)
-> Maybe Text -> BugsnagEvent -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hash

-- | Set @'beGroupingHash'@ based on the Event
setGroupingHashBy :: (BugsnagEvent -> Maybe Text) -> BeforeNotify
setGroupingHashBy :: (BugsnagEvent -> Maybe Text) -> BeforeNotify
setGroupingHashBy BugsnagEvent -> Maybe Text
f BugsnagEvent
event = BugsnagEvent
event { beGroupingHash :: Maybe Text
beGroupingHash = BugsnagEvent -> Maybe Text
f BugsnagEvent
event }

-- | Update the @'BugsnagEvent'@ based on its @'BugsnagException'@
--
-- Use this instead of @'updateException'@ if you want to do other things to the
-- Event, such as set its @'beGroupingHash'@ based on the Exception.
--
updateEventFromException :: (BugsnagException -> BeforeNotify) -> BeforeNotify
updateEventFromException :: (BugsnagException -> BeforeNotify) -> BeforeNotify
updateEventFromException BugsnagException -> BeforeNotify
f BugsnagEvent
event = BugsnagException -> BeforeNotify
f (BugsnagEvent -> BugsnagException
beException BugsnagEvent
event) BugsnagEvent
event

-- | Update the @'BugsnagEvent'@ 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' $ \ex -> ex
--         { beErrorClass = sqlErrorCode
--         , beMessage = sqlErrorMessage
--         }
-- @
--
-- If there is no original exception, or the cast fails, the event is unchanged.
--
updateEventFromOriginalException
    :: Exception e => (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException :: (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException e -> BeforeNotify
f BugsnagEvent
event = BugsnagEvent -> Maybe BugsnagEvent -> BugsnagEvent
forall a. a -> Maybe a -> a
fromMaybe BugsnagEvent
event (Maybe BugsnagEvent -> BugsnagEvent)
-> Maybe BugsnagEvent -> BugsnagEvent
forall a b. (a -> b) -> a -> b
$ do
    SomeException
someException <- BugsnagException -> Maybe SomeException
beOriginalException (BugsnagException -> Maybe SomeException)
-> BugsnagException -> Maybe SomeException
forall a b. (a -> b) -> a -> b
$ BugsnagEvent -> BugsnagException
beException BugsnagEvent
event
    e
yourException <- SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
someException
    BugsnagEvent -> Maybe BugsnagEvent
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BugsnagEvent -> Maybe BugsnagEvent)
-> BugsnagEvent -> Maybe BugsnagEvent
forall a b. (a -> b) -> a -> b
$ e -> BeforeNotify
f e
yourException BugsnagEvent
event

-- | Set the events @'BugsnagEvent'@ and @'BugsnagDevice'@
--
-- This function redacts the following Request headers:
--
-- - Authorization
-- - Cookie
-- - X-XSRF-TOKEN (CSRF token header used by Yesod)
--
-- To avoid this, use @'updateEventFromWaiRequestUnredacted'@.
--
updateEventFromWaiRequest :: Request -> BeforeNotify
updateEventFromWaiRequest :: Request -> BeforeNotify
updateEventFromWaiRequest Request
wrequest =
    [HeaderName] -> BeforeNotify
redactRequestHeaders [HeaderName
"Authorization", HeaderName
"Cookie", HeaderName
"X-XSRF-TOKEN"]
        BeforeNotify -> BeforeNotify -> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> BeforeNotify
updateEventFromWaiRequestUnredacted Request
wrequest

updateEventFromWaiRequestUnredacted :: Request -> BeforeNotify
updateEventFromWaiRequestUnredacted :: Request -> BeforeNotify
updateEventFromWaiRequestUnredacted Request
wrequest =
    let
        mdevice :: Maybe BugsnagDevice
mdevice = Request -> Maybe BugsnagDevice
bugsnagDeviceFromWaiRequest Request
wrequest
        request :: BugsnagRequest
request = Request -> BugsnagRequest
bugsnagRequestFromWaiRequest Request
wrequest
    in BeforeNotify
-> (BugsnagDevice -> BeforeNotify)
-> Maybe BugsnagDevice
-> BeforeNotify
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BeforeNotify
forall a. a -> a
id BugsnagDevice -> BeforeNotify
setDevice Maybe BugsnagDevice
mdevice BeforeNotify -> BeforeNotify -> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BugsnagRequest -> BeforeNotify
setRequest BugsnagRequest
request

-- | Update the Event's Context and User from the Session
updateEventFromSession :: BugsnagSession -> BeforeNotify
updateEventFromSession :: BugsnagSession -> BeforeNotify
updateEventFromSession BugsnagSession
session BugsnagEvent
event =
    BugsnagEvent
event { beContext :: Maybe Text
beContext = BugsnagSession -> Maybe Text
bsContext BugsnagSession
session, beUser :: Maybe BugsnagUser
beUser = BugsnagSession -> Maybe BugsnagUser
bsUser BugsnagSession
session }

-- | Redact the given request headers
--
-- Headers like @Authorization@ may contain information you don't want to report
-- to Bugsnag.
--
-- > redactRequestHeaders ["Authorization", "Cookie"]
--
redactRequestHeaders :: [HeaderName] -> BeforeNotify
redactRequestHeaders :: [HeaderName] -> BeforeNotify
redactRequestHeaders [HeaderName]
headers BugsnagEvent
event =
    BugsnagEvent
event { beRequest :: Maybe BugsnagRequest
beRequest = [HeaderName] -> BugsnagRequest -> BugsnagRequest
redactHeaders [HeaderName]
headers (BugsnagRequest -> BugsnagRequest)
-> Maybe BugsnagRequest -> Maybe BugsnagRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BugsnagEvent -> Maybe BugsnagRequest
beRequest BugsnagEvent
event }

-- |
--
-- >>> let headers = [("Authorization", "secret"), ("X-Foo", "Bar")]
-- >>> let req = bugsnagRequest { brHeaders = Just $ bugsnagRequestHeaders headers }
-- >>> brHeaders $ redactHeaders ["Authorization"] req
-- Just (BugsnagRequestHeaders {unBugsnagRequestHeaders = [("Authorization","<redacted>"),("X-Foo","Bar")]})
--
redactHeaders :: [HeaderName] -> BugsnagRequest -> BugsnagRequest
redactHeaders :: [HeaderName] -> BugsnagRequest -> BugsnagRequest
redactHeaders [HeaderName]
headers BugsnagRequest
request = BugsnagRequest
request
    { brHeaders :: Maybe BugsnagRequestHeaders
brHeaders = [HeaderName] -> BugsnagRequestHeaders -> BugsnagRequestHeaders
redactBugsnagRequestHeaders [HeaderName]
headers (BugsnagRequestHeaders -> BugsnagRequestHeaders)
-> Maybe BugsnagRequestHeaders -> Maybe BugsnagRequestHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BugsnagRequest -> Maybe BugsnagRequestHeaders
brHeaders BugsnagRequest
request
    }

-- | Set the Event's Request
--
-- See @'bugsnagRequestFromWaiRequest'@
--
setRequest :: BugsnagRequest -> BeforeNotify
setRequest :: BugsnagRequest -> BeforeNotify
setRequest BugsnagRequest
request BugsnagEvent
event = BugsnagEvent
event { beRequest :: Maybe BugsnagRequest
beRequest = BugsnagRequest -> Maybe BugsnagRequest
forall a. a -> Maybe a
Just BugsnagRequest
request }

-- | Set the Event's Device
--
-- See @'bugsnagDeviceFromWaiRequest'@
--
setDevice :: BugsnagDevice -> BeforeNotify
setDevice :: BugsnagDevice -> BeforeNotify
setDevice BugsnagDevice
device BugsnagEvent
event = BugsnagEvent
event { beDevice :: Maybe BugsnagDevice
beDevice = BugsnagDevice -> Maybe BugsnagDevice
forall a. a -> Maybe a
Just BugsnagDevice
device }

-- | Set the stacktrace on the reported exception
--
-- > notifyBugsnagWith (setStacktrace [$(currentStackFrame) "myFunc"]) ...
--
setStacktrace :: [BugsnagStackFrame] -> BeforeNotify
setStacktrace :: [BugsnagStackFrame] -> BeforeNotify
setStacktrace [BugsnagStackFrame]
stacktrace =
    (BugsnagException -> BugsnagException) -> BeforeNotify
updateException ((BugsnagException -> BugsnagException) -> BeforeNotify)
-> (BugsnagException -> BugsnagException) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \BugsnagException
ex -> BugsnagException
ex { beStacktrace :: [BugsnagStackFrame]
beStacktrace = [BugsnagStackFrame]
stacktrace }

-- | Set to @'ErrorSeverity'@
setErrorSeverity :: BeforeNotify
setErrorSeverity :: BeforeNotify
setErrorSeverity = BugsnagSeverity -> BeforeNotify
setSeverity BugsnagSeverity
ErrorSeverity

-- | Set to @'WarningSeverity'@
setWarningSeverity :: BeforeNotify
setWarningSeverity :: BeforeNotify
setWarningSeverity = BugsnagSeverity -> BeforeNotify
setSeverity BugsnagSeverity
WarningSeverity

-- | Set to @'InfoSeverity'@
setInfoSeverity :: BeforeNotify
setInfoSeverity :: BeforeNotify
setInfoSeverity = BugsnagSeverity -> BeforeNotify
setSeverity BugsnagSeverity
InfoSeverity

setSeverity :: BugsnagSeverity -> BeforeNotify
setSeverity :: BugsnagSeverity -> BeforeNotify
setSeverity BugsnagSeverity
severity BugsnagEvent
event = BugsnagEvent
event { beSeverity :: Maybe BugsnagSeverity
beSeverity = BugsnagSeverity -> Maybe BugsnagSeverity
forall a. a -> Maybe a
Just BugsnagSeverity
severity }