-- |
--
-- <https://docs.bugsnag.com/api/error-reporting/#application-settings>
--
module Network.Bugsnag.Settings
    ( BugsnagApiKey(..)
    , BugsnagSettings(..)
    , newBugsnagSettings
    , bugsnagSettings
    , bugsnagShouldNotify
    ) where

import Prelude

import Data.Aeson (FromJSON)
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Network.Bugsnag.BeforeNotify
import Network.Bugsnag.CodeIndex
import Network.Bugsnag.Event
import Network.Bugsnag.Exception
import Network.Bugsnag.ReleaseStage
import Network.HTTP.Client
import Network.HTTP.Client.TLS

newtype BugsnagApiKey = BugsnagApiKey
    { BugsnagApiKey -> Text
unBugsnagApiKey :: Text
    }
    deriving newtype (Value -> Parser [BugsnagApiKey]
Value -> Parser BugsnagApiKey
(Value -> Parser BugsnagApiKey)
-> (Value -> Parser [BugsnagApiKey]) -> FromJSON BugsnagApiKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BugsnagApiKey]
$cparseJSONList :: Value -> Parser [BugsnagApiKey]
parseJSON :: Value -> Parser BugsnagApiKey
$cparseJSON :: Value -> Parser BugsnagApiKey
FromJSON, String -> BugsnagApiKey
(String -> BugsnagApiKey) -> IsString BugsnagApiKey
forall a. (String -> a) -> IsString a
fromString :: String -> BugsnagApiKey
$cfromString :: String -> BugsnagApiKey
IsString)

instance Show BugsnagApiKey where
    show :: BugsnagApiKey -> String
show = Text -> String
T.unpack (Text -> String)
-> (BugsnagApiKey -> Text) -> BugsnagApiKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BugsnagApiKey -> Text
unBugsnagApiKey

-- | Notifier settings
--
-- See @'newBugsnagSettings'@.
--
data BugsnagSettings = BugsnagSettings
    { BugsnagSettings -> BugsnagApiKey
bsApiKey :: BugsnagApiKey
    -- ^ Your Integration API Key.
    , BugsnagSettings -> Maybe Text
bsAppVersion :: Maybe Text
    -- ^ The version of your application
    --
    -- Marking bugs as Fixed and having them auto-reopen in new versions
    -- requires you set this.
    --
    , BugsnagSettings -> BugsnagReleaseStage
bsReleaseStage :: BugsnagReleaseStage
    -- ^ The current release-stage, Production by default
    , BugsnagSettings -> [BugsnagReleaseStage]
bsNotifyReleaseStages :: [BugsnagReleaseStage]
    -- ^ Which release-stages to notify in. Only Production by default
    , BugsnagSettings -> BeforeNotify
bsBeforeNotify :: BeforeNotify
    -- ^ Modify any events before they are sent
    --
    -- For example to attach a user, or set the context.
    --
    , BugsnagSettings -> BugsnagException -> Bool
bsIgnoreException :: BugsnagException -> Bool
    -- ^ Exception filtering
    --
    -- Functions like @'notifyBugsnag'@ will do nothing with exceptions that
    -- pass this predicate. N.B. Something lower-level, like @'reportError'@
    -- won't be aware of this.
    --
    , BugsnagSettings -> Manager
bsHttpManager :: Manager
    -- ^ The HTTP @Manager@ used to emit notifications
    --
    -- It's more efficient, and ensures proper resource cleanup, to share a
    -- single manager across an application. Must be TLS-enabled.
    --
    , BugsnagSettings -> Maybe CodeIndex
bsCodeIndex :: Maybe CodeIndex
    -- ^ A @'CodeIndex'@ built at compile-time from project sources
    --
    -- If set, this will be used to update StackFrames to include lines of
    -- source code context as read out of this value. N.B. using this means
    -- loading and keeping the source code for the entire project in memory.
    --
    }

-- | Construct settings purely, given an existing @'Manager'@
bugsnagSettings :: BugsnagApiKey -> Manager -> BugsnagSettings
bugsnagSettings :: BugsnagApiKey -> Manager -> BugsnagSettings
bugsnagSettings BugsnagApiKey
apiKey Manager
manager = BugsnagSettings :: BugsnagApiKey
-> Maybe Text
-> BugsnagReleaseStage
-> [BugsnagReleaseStage]
-> BeforeNotify
-> (BugsnagException -> Bool)
-> Manager
-> Maybe CodeIndex
-> BugsnagSettings
BugsnagSettings
    { bsApiKey :: BugsnagApiKey
bsApiKey = BugsnagApiKey
apiKey
    , bsAppVersion :: Maybe Text
bsAppVersion = Maybe Text
forall a. Maybe a
Nothing
    , bsReleaseStage :: BugsnagReleaseStage
bsReleaseStage = BugsnagReleaseStage
ProductionReleaseStage
    , bsNotifyReleaseStages :: [BugsnagReleaseStage]
bsNotifyReleaseStages = [BugsnagReleaseStage
ProductionReleaseStage]
    , bsBeforeNotify :: BeforeNotify
bsBeforeNotify = BeforeNotify
forall a. a -> a
id
    , bsIgnoreException :: BugsnagException -> Bool
bsIgnoreException = Bool -> BugsnagException -> Bool
forall a b. a -> b -> a
const Bool
False
    , bsHttpManager :: Manager
bsHttpManager = Manager
manager
    , bsCodeIndex :: Maybe CodeIndex
bsCodeIndex = Maybe CodeIndex
forall a. Maybe a
Nothing
    }

-- | Should this @'BugsnagEvent'@ trigger notification?
--
-- >>> settings <- newBugsnagSettings ""
-- >>> let event = bugsnagEvent $ bugsnagException "" "" []
-- >>> bugsnagShouldNotify settings event
-- True
--
-- >>> let devSettings = settings { bsReleaseStage = DevelopmentReleaseStage }
-- >>> bugsnagShouldNotify devSettings event
-- False
--
-- >>> bugsnagShouldNotify devSettings { bsNotifyReleaseStages = [DevelopmentReleaseStage] } event
-- True
--
-- >>> let ignore = (== "IgnoreMe") . beErrorClass
-- >>> let ignoreSettings = settings { bsIgnoreException = ignore }
-- >>> let ignoreEvent = bugsnagEvent $ bugsnagException "IgnoreMe" "" []
-- >>> bugsnagShouldNotify ignoreSettings event
-- True
--
-- >>> bugsnagShouldNotify ignoreSettings ignoreEvent
-- False
--
bugsnagShouldNotify :: BugsnagSettings -> BugsnagEvent -> Bool
bugsnagShouldNotify :: BugsnagSettings -> BugsnagEvent -> Bool
bugsnagShouldNotify BugsnagSettings
settings BugsnagEvent
event
    | BugsnagSettings -> BugsnagReleaseStage
bsReleaseStage BugsnagSettings
settings BugsnagReleaseStage -> [BugsnagReleaseStage] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` BugsnagSettings -> [BugsnagReleaseStage]
bsNotifyReleaseStages BugsnagSettings
settings = Bool
False
    | BugsnagSettings -> BugsnagException -> Bool
bsIgnoreException BugsnagSettings
settings (BugsnagException -> Bool) -> BugsnagException -> Bool
forall a b. (a -> b) -> a -> b
$ BugsnagEvent -> BugsnagException
beException BugsnagEvent
event = Bool
False
    | Bool
otherwise = Bool
True

-- | Construct settings with a new, TLS-enabled @'Manager'@
--
-- Uses @'getGlobalManager'@.
--
-- >>> settings <- newBugsnagSettings "API_KEY"
-- >>> bsApiKey settings
-- API_KEY
--
-- >>> bsReleaseStage settings
-- ProductionReleaseStage
--
-- >>> bsNotifyReleaseStages settings
-- [ProductionReleaseStage]
--
newBugsnagSettings :: BugsnagApiKey -> IO BugsnagSettings
newBugsnagSettings :: BugsnagApiKey -> IO BugsnagSettings
newBugsnagSettings BugsnagApiKey
apiKey = BugsnagApiKey -> Manager -> BugsnagSettings
bugsnagSettings BugsnagApiKey
apiKey (Manager -> BugsnagSettings) -> IO Manager -> IO BugsnagSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Manager
getGlobalManager