{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- A module for building Bugsnag report payloads.
-- Please see the README at <https://github.com/jwoudenberg/bugsnag-hs>.
module Network.Bugsnag
  ( -- * Sending reports
    sendEvents,

    -- ** ApiKey
    ApiKey,
    apiKey,

    -- ** Report
    Report,
    defaultReport,
    report_apiKey,
    report_payloadVersion,
    report_notifier,
    report_events,

    -- ** Event
    Event,
    defaultEvent,
    event_exceptions,
    event_breadcrumbs,
    event_request,
    event_threads,
    event_context,
    event_groupingHash,
    event_unhandled,
    event_severity,
    event_severityReason,
    event_user,
    event_app,
    event_device,
    event_session,
    event_metaData,

    -- ** Exception
    Exception,
    defaultException,
    exception_errorClass,
    exception_message,
    exception_stacktrace,
    exception_type,

    -- ** StackFrame
    StackFrame,
    defaultStackFrame,
    stackFrame_file,
    stackFrame_lineNumber,
    stackFrame_columnNumber,
    stackFrame_method,
    stackFrame_inProject,
    stackFrame_code,

    -- ** Breadcrumb
    Breadcrumb,
    defaultBreadcrumb,
    breadcrumb_timestamp,
    breadcrumb_name,
    breadcrumb_type,
    breadcrumb_metaData,

    -- ** Request
    Request,
    defaultRequest,
    request_clientIp,
    request_headers,
    request_httpMethod,
    request_url,
    request_referer,

    -- ** Thread
    Thread,
    defaultThread,
    thread_id,
    thread_name,
    thread_errorReportingThread,
    thread_stacktrace,
    thread_type,

    -- ** SeverityReason
    SeverityReason,
    defaultSeverityReason,
    severityReason_type,
    severityReason_attributes,

    -- ** SeverityReasonAttributes
    SeverityReasonAttributes,
    defaultSeverityReasonAttributes,
    severityReasonAttributes_errorType,
    severityReasonAttributes_level,
    severityReasonAttributes_signalType,
    severityReasonAttributes_violationType,
    severityReasonAttributes_errorClass,

    -- ** User
    User,
    defaultUser,
    user_id,
    user_name,
    user_email,

    -- ** App
    App,
    defaultApp,
    app_id,
    app_version,
    app_versionCode,
    app_bundleVersion,
    app_codeBundleId,
    app_buildUUID,
    app_releaseStage,
    app_type,
    app_dsymUUIDs,
    app_duration,
    app_durationInForeground,
    app_inForeground,
    app_binaryArch,

    -- ** Device
    Device,
    defaultDevice,
    device_hostname,
    device_id,
    device_manufacturer,
    device_model,
    device_modelNumber,
    device_osName,
    device_osVersion,
    device_freeMemory,
    device_totalMemory,
    device_freeDisk,
    device_browserName,
    device_browserVersion,
    device_jailBroken,
    device_orientation,
    device_time,
    device_cpuAbi,
    device_runtimeVersions,

    -- ** RuntimeVersions
    RuntimeVersions,
    defaultRuntimeVersions,
    runtimeVersions_androidApi,
    runtimeVersions_bottle,
    runtimeVersions_celery,
    runtimeVersions_clangVersion,
    runtimeVersions_cocos2dx,
    runtimeVersions_delayedJob,
    runtimeVersions_django,
    runtimeVersions_dotnet,
    runtimeVersions_dotnetApiCompatibility,
    runtimeVersions_dotnetClr,
    runtimeVersions_dotnetScriptingRuntime,
    runtimeVersions_eventMachine,
    runtimeVersions_expoApp,
    runtimeVersions_expoSdk,
    runtimeVersions_flask,
    runtimeVersions_gin,
    runtimeVersions_go,
    runtimeVersions_javaType,
    runtimeVersions_javaVersion,
    runtimeVersions_jruby,
    runtimeVersions_laravel,
    runtimeVersions_lumen,
    runtimeVersions_magento,
    runtimeVersions_mailman,
    runtimeVersions_martini,
    runtimeVersions_negroni,
    runtimeVersions_node,
    runtimeVersions_osBuild,
    runtimeVersions_php,
    runtimeVersions_python,
    runtimeVersions_que,
    runtimeVersions_rack,
    runtimeVersions_rails,
    runtimeVersions_rake,
    runtimeVersions_reactNative,
    runtimeVersions_reactNativeJsEngine,
    runtimeVersions_resque,
    runtimeVersions_revel,
    runtimeVersions_ruby,
    runtimeVersions_shoryoken,
    runtimeVersions_sidekiq,
    runtimeVersions_silex,
    runtimeVersions_sinatra,
    runtimeVersions_springBoot,
    runtimeVersions_springFramework,
    runtimeVersions_swift,
    runtimeVersions_symfony,
    runtimeVersions_tornado,
    runtimeVersions_unity,
    runtimeVersions_unityScriptingBackend,
    runtimeVersions_wordpress,

    -- ** Session
    Session,
    defaultSession,
    session_id,
    session_startedAt,
    session_events,

    -- ** SessionEvents
    SessionEvents,
    defaultSessionEvents,
    sessionEvents_handled,
    sessionEvents_unhandled,

    -- ** PayloadVersion
    PayloadVersion,
    payloadVersion5,

    -- ** Notifier
    Notifier,
    thisNotifier,

    -- ** ExceptionType
    ExceptionType,
    cocoaExceptionType,
    androidExceptionType,
    browserjsExceptionType,
    expojsExceptionType,
    nodejsExceptionType,

    -- ** BreadcrumbType
    BreadcrumbType,
    navigationBreadcrumbType,
    requestBreadcrumbType,
    processBreadcrumbType,
    logBreadcrumbType,
    userBreadcrumbType,
    stateBreadcrumbType,
    errorBreadcrumbType,
    manualBreadcrumbType,

    -- ** Thread
    ThreadType,
    cocoaThreadType,
    androidThreadType,
    browserjsThreadType,

    -- ** Severity
    Severity,
    errorSeverity,
    warningSeverity,
    infoSeverity,

    -- ** SeverityReasonType
    SeverityReasonType,
    unhandledExceptionSeverityReasonType,
    unhandledErrorSeverityReasonType,
    logSeverityReasonType,
    signalSeverityReasonType,
    strictModeSeverityReasonType,
    unhandledPromiseRejectionSeverityReasonType,
    callbackErrorInterceptSeverityReasonType,
    errorClassSeverityReasonType,
    unhandledPanicSeverityReasonType,
    userCallbackSetSeveritySeverityReasonType,
    userSpecifiedSeveritySeverityReasonType,
    handledExceptionSeverityReasonType,
    handledErrorSeverityReasonType,
    handledPanicSeverityReasonType,
    userContextSetSeveritySeverityReasonType,
    anrErrorSeverityReasonType,
    outOfMemorySeverityReasonType,

    -- ** BinaryArch
    BinaryArch,
    x86BinaryArch,
    x86_64BinaryArch,
    arm32BinaryArch,
    arm64BinaryArch,

    -- ** CpuAbi
    CpuAbi,
    x86_64CpuAbi,
  )
where

import Control.Exception (try)
import Control.Monad (void)
import qualified Data.Aeson
import qualified Data.ByteString.Char8
import Data.Foldable (toList)
import Data.HashMap.Strict (HashMap)
import Data.Text (Text, intercalate, pack)
import qualified Data.Text.Encoding
import qualified Data.Time.Clock
import qualified Data.Time.Format
import qualified Data.Version as Version
import GHC.Generics (Generic)
import qualified Network.HTTP.Client as HTTP
import Paths_bugsnag_hs (version)

-- | Send a batch of 'Event's to Rollbar using a single HTTP request.
sendEvents :: HTTP.Manager -> ApiKey -> [Event] -> IO (Either HTTP.HttpException ())
sendEvents :: Manager -> ApiKey -> [Event] -> IO (Either HttpException ())
sendEvents Manager
manager ApiKey
apiKey [Event]
events = do
  Manager -> ApiKey -> Report -> IO (Either HttpException ())
send
    Manager
manager
    ApiKey
apiKey
    Report :: Maybe ApiKey -> PayloadVersion -> Notifier -> [Event] -> Report
Report
      { report_apiKey :: Maybe ApiKey
report_apiKey = Maybe ApiKey
forall a. Maybe a
Nothing,
        report_payloadVersion :: PayloadVersion
report_payloadVersion = PayloadVersion
payloadVersion5,
        report_notifier :: Notifier
report_notifier = Notifier
thisNotifier,
        report_events :: [Event]
report_events = [Event]
events
      }

send :: HTTP.Manager -> ApiKey -> Report -> IO (Either HTTP.HttpException ())
send :: Manager -> ApiKey -> Report -> IO (Either HttpException ())
send Manager
manager (ApiKey Text
apiKey) Report
report = do
  UTCTime
now <- IO UTCTime
Data.Time.Clock.getCurrentTime
  Request
initReq <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseUrlThrow String
"https://notify.bugsnag.com"
  let req :: Request
req =
        Request
initReq
          { method :: Method
HTTP.method = Method
"POST",
            requestHeaders :: RequestHeaders
HTTP.requestHeaders =
              [ (HeaderName
"Bugsnag-Api-Key", Text -> Method
Data.Text.Encoding.encodeUtf8 Text
apiKey),
                (HeaderName
"Content-Type", Method
"application/json"),
                (HeaderName
"Bugsnag-Payload-Version", Method
"5"),
                (HeaderName
"Bugsnag-Sent-At", String -> Method
Data.ByteString.Char8.pack (UTCTime -> String
formatISO8601 UTCTime
now))
              ],
            requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS (Report -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.encode Report
report)
          }
  IO () -> IO (Either HttpException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either HttpException ()))
-> (IO (Response ()) -> IO ())
-> IO (Response ())
-> IO (Either HttpException ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Response ()) -> IO (Either HttpException ()))
-> IO (Response ()) -> IO (Either HttpException ())
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ())
HTTP.httpNoBody Request
req Manager
manager

formatISO8601 :: Data.Time.Clock.UTCTime -> String
formatISO8601 :: UTCTime -> String
formatISO8601 = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Data.Time.Format.formatTime TimeLocale
Data.Time.Format.defaultTimeLocale String
"%FT%T%QZ"

-- | The payload of a POST request to https://notify.bugsnag.com/
data Report = Report
  { -- | The API Key associated with the project. Informs Bugsnag which project has generated this error.
    -- This is provided for legacy notifiers. It is preferable to use the Bugsnag-Api-Key header instead.
    Report -> Maybe ApiKey
report_apiKey :: Maybe ApiKey,
    -- | The version number of the payload. This is currently 5.
    -- The Bugsnag-Payload-Version header should be included as well, for compatibility reasons.
    Report -> PayloadVersion
report_payloadVersion :: PayloadVersion,
    -- | Describes the notifier itself. These properties are used within Bugsnag to track error rates from a notifier.
    Report -> Notifier
report_notifier :: Notifier,
    -- | An array of error events that Bugsnag should be notified of. A notifier can choose to group notices into an array to minimize network traffic, or can notify Bugsnag each time an event occurs.
    Report -> [Event]
report_events :: [Event]
  }
  deriving ((forall x. Report -> Rep Report x)
-> (forall x. Rep Report x -> Report) -> Generic Report
forall x. Rep Report x -> Report
forall x. Report -> Rep Report x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Report x -> Report
$cfrom :: forall x. Report -> Rep Report x
Generic, Int -> Report -> ShowS
[Report] -> ShowS
Report -> String
(Int -> Report -> ShowS)
-> (Report -> String) -> ([Report] -> ShowS) -> Show Report
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Report] -> ShowS
$cshowList :: [Report] -> ShowS
show :: Report -> String
$cshow :: Report -> String
showsPrec :: Int -> Report -> ShowS
$cshowsPrec :: Int -> Report -> ShowS
Show)

instance Data.Aeson.ToJSON Report where
  toJSON :: Report -> Value
toJSON = Options -> Report -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Report -> Encoding
toEncoding = Options -> Report -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Report where
  parseJSON :: Value -> Parser Report
parseJSON = Options -> Value -> Parser Report
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default report.
defaultReport :: Report
defaultReport :: Report
defaultReport =
  Report :: Maybe ApiKey -> PayloadVersion -> Notifier -> [Event] -> Report
Report
    { report_apiKey :: Maybe ApiKey
report_apiKey = Maybe ApiKey
forall a. Maybe a
Nothing,
      report_payloadVersion :: PayloadVersion
report_payloadVersion = PayloadVersion
payloadVersion5,
      report_notifier :: Notifier
report_notifier = Notifier
thisNotifier,
      report_events :: [Event]
report_events = []
    }

-- | The API Key associated with the project. Informs Bugsnag which project has generated this error.
newtype ApiKey = ApiKey Text
  deriving ((forall x. ApiKey -> Rep ApiKey x)
-> (forall x. Rep ApiKey x -> ApiKey) -> Generic ApiKey
forall x. Rep ApiKey x -> ApiKey
forall x. ApiKey -> Rep ApiKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiKey x -> ApiKey
$cfrom :: forall x. ApiKey -> Rep ApiKey x
Generic, Int -> ApiKey -> ShowS
[ApiKey] -> ShowS
ApiKey -> String
(Int -> ApiKey -> ShowS)
-> (ApiKey -> String) -> ([ApiKey] -> ShowS) -> Show ApiKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiKey] -> ShowS
$cshowList :: [ApiKey] -> ShowS
show :: ApiKey -> String
$cshow :: ApiKey -> String
showsPrec :: Int -> ApiKey -> ShowS
$cshowsPrec :: Int -> ApiKey -> ShowS
Show)

instance Data.Aeson.ToJSON ApiKey where
  toJSON :: ApiKey -> Value
toJSON = Options -> ApiKey -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: ApiKey -> Encoding
toEncoding = Options -> ApiKey -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON ApiKey where
  parseJSON :: Value -> Parser ApiKey
parseJSON = Options -> Value -> Parser ApiKey
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | Construct an 'ApiKey' value.
apiKey :: Text -> ApiKey
apiKey :: Text -> ApiKey
apiKey = Text -> ApiKey
ApiKey

-- | The version number of the payload. This is currently 5.
-- The Bugsnag-Payload-Version header should be included as well, for compatibility reasons.
newtype PayloadVersion = PayloadVersion Text
  deriving ((forall x. PayloadVersion -> Rep PayloadVersion x)
-> (forall x. Rep PayloadVersion x -> PayloadVersion)
-> Generic PayloadVersion
forall x. Rep PayloadVersion x -> PayloadVersion
forall x. PayloadVersion -> Rep PayloadVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PayloadVersion x -> PayloadVersion
$cfrom :: forall x. PayloadVersion -> Rep PayloadVersion x
Generic, Int -> PayloadVersion -> ShowS
[PayloadVersion] -> ShowS
PayloadVersion -> String
(Int -> PayloadVersion -> ShowS)
-> (PayloadVersion -> String)
-> ([PayloadVersion] -> ShowS)
-> Show PayloadVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PayloadVersion] -> ShowS
$cshowList :: [PayloadVersion] -> ShowS
show :: PayloadVersion -> String
$cshow :: PayloadVersion -> String
showsPrec :: Int -> PayloadVersion -> ShowS
$cshowsPrec :: Int -> PayloadVersion -> ShowS
Show)

instance Data.Aeson.ToJSON PayloadVersion where
  toJSON :: PayloadVersion -> Value
toJSON = Options -> PayloadVersion -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: PayloadVersion -> Encoding
toEncoding = Options -> PayloadVersion -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON PayloadVersion where
  parseJSON :: Value -> Parser PayloadVersion
parseJSON = Options -> Value -> Parser PayloadVersion
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | This API only supports payload version 5.
payloadVersion5 :: PayloadVersion
payloadVersion5 :: PayloadVersion
payloadVersion5 = Text -> PayloadVersion
PayloadVersion Text
"5"

-- | Describes the notifier itself. These properties are used within Bugsnag to track error rates from a notifier.
data Notifier = Notifier
  { -- | The notifier name.
    Notifier -> Text
notifier_name :: Text,
    -- | The notifier's current version.
    Notifier -> Text
notifier_version :: Text,
    -- | The URL associated with the notifier.
    Notifier -> Text
notifier_url :: Text
  }
  deriving ((forall x. Notifier -> Rep Notifier x)
-> (forall x. Rep Notifier x -> Notifier) -> Generic Notifier
forall x. Rep Notifier x -> Notifier
forall x. Notifier -> Rep Notifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Notifier x -> Notifier
$cfrom :: forall x. Notifier -> Rep Notifier x
Generic, Int -> Notifier -> ShowS
[Notifier] -> ShowS
Notifier -> String
(Int -> Notifier -> ShowS)
-> (Notifier -> String) -> ([Notifier] -> ShowS) -> Show Notifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notifier] -> ShowS
$cshowList :: [Notifier] -> ShowS
show :: Notifier -> String
$cshow :: Notifier -> String
showsPrec :: Int -> Notifier -> ShowS
$cshowsPrec :: Int -> Notifier -> ShowS
Show)

instance Data.Aeson.ToJSON Notifier where
  toJSON :: Notifier -> Value
toJSON = Options -> Notifier -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Notifier -> Encoding
toEncoding = Options -> Notifier -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Notifier where
  parseJSON :: Value -> Parser Notifier
parseJSON = Options -> Value -> Parser Notifier
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | Information describing the notifier in this module.
thisNotifier :: Notifier
thisNotifier :: Notifier
thisNotifier =
  Notifier :: Text -> Text -> Text -> Notifier
Notifier
    { notifier_name :: Text
notifier_name = Text
"bugsnag-hs",
      notifier_version :: Text
notifier_version = Text -> [Text] -> Text
intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> [Int]
Version.versionBranch Version
version,
      notifier_url :: Text
notifier_url = Text
"https://github.com/jwoudenberg/bugsnag-hs#readme"
    }

-- | An array of error events that Bugsnag should be notified of. A notifier can choose to group notices into an array to minimize network traffic, or can notify Bugsnag each time an event occurs.
data Event = Event
  { -- | An array of exceptions that occurred during this event. There must be at least one entry. Most of the time there will only be one exception, but some languages support "nested" or "caused by" exceptions. In this case, exceptions should be unwrapped and added to the array one at a time. The first exception raised should be first in this array.
    Event -> [Exception]
event_exceptions :: [Exception],
    -- | An array of user- and system-initiated events which led up to an error, providing additional context. This list is sequential and ordered newest to oldest.
    Event -> Maybe [Breadcrumb]
event_breadcrumbs :: Maybe [Breadcrumb],
    -- | Details about the web request from the client that experienced the error, if relevant. To display custom request data alongside these standard fields on the Bugsnag website, the custom data should be included in the metaData object in a request object.
    Event -> Maybe Request
event_request :: Maybe Request,
    -- | An array of background threads. This is optional but recommended for apps that rely heavily on threading. Threads should be in an order that makes sense for your application.
    Event -> Maybe [Thread]
event_threads :: Maybe [Thread],
    -- | A string representing what was happening in the application at the time of the error. This string could be used for grouping purposes, depending on the event. Usually this would represent the controller and action in a server based project. It could represent the screen that the user was interacting with in a client side project. For example:
    -- - On Ruby on Rails the context could be controller#action.
    -- - In Android, the context could be the top most Activity.
    -- - In iOS, the context could be the name of the top most UIViewController.
    Event -> Maybe Text
event_context :: Maybe Text,
    -- | Bugsnag's default error grouping can be overridden by specifying a custom grouping hash.
    Event -> Maybe Text
event_groupingHash :: Maybe Text,
    -- | Whether the error was unhandled. If true, the error was detected by the notifier because it was not handled by the application. If false, the errors was handled and reported using Bugsnag.notify.
    Event -> Maybe Bool
event_unhandled :: Maybe Bool,
    -- | The severity of the error
    Event -> Maybe Severity
event_severity :: Maybe Severity,
    -- | Information about why the severity was picked.
    Event -> Maybe SeverityReason
event_severityReason :: Maybe SeverityReason,
    -- | Information about the user affected by the error. These fields are optional but highly recommended. To display custom user data alongside these standard fields on the Bugsnag website, the custom data should be included in the metaData object in a user object.
    Event -> Maybe User
event_user :: Maybe User,
    -- | Information about the app where the error occurred. These fields are optional but highly recommended. To display custom app data alongside these standard fields on the Bugsnag website, the custom data should be included in the metaData object in an app object.
    Event -> Maybe App
event_app :: Maybe App,
    -- | Information about the computer/device running the app. These fields are optional but highly recommended. To display custom device data alongside these standard fields on the Bugsnag website, the custom data should be included in the metaData object in a device object.
    Event -> Maybe Device
event_device :: Maybe Device,
    -- | Details of any session information associated with the event.
    -- This can be used alongside the Bugsnag Session Tracking API to associate the event with a session so that a release's crash rate can be determined.
    Event -> Maybe Session
event_session :: Maybe Session,
    -- | An object containing any further data you wish to attach to this error event. This should contain one or more objects, with each object being displayed in its own tab on the event details on Bugsnag.
    Event -> Maybe Object
event_metaData :: Maybe Data.Aeson.Object
  }
  deriving ((forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

instance Data.Aeson.ToJSON Event where
  toJSON :: Event -> Value
toJSON = Options -> Event -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Event -> Encoding
toEncoding = Options -> Event -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Event where
  parseJSON :: Value -> Parser Event
parseJSON = Options -> Value -> Parser Event
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default event.
defaultEvent :: Event
defaultEvent :: Event
defaultEvent =
  Event :: [Exception]
-> Maybe [Breadcrumb]
-> Maybe Request
-> Maybe [Thread]
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Severity
-> Maybe SeverityReason
-> Maybe User
-> Maybe App
-> Maybe Device
-> Maybe Session
-> Maybe Object
-> Event
Event
    { event_exceptions :: [Exception]
event_exceptions = [],
      event_breadcrumbs :: Maybe [Breadcrumb]
event_breadcrumbs = Maybe [Breadcrumb]
forall a. Maybe a
Nothing,
      event_request :: Maybe Request
event_request = Maybe Request
forall a. Maybe a
Nothing,
      event_threads :: Maybe [Thread]
event_threads = Maybe [Thread]
forall a. Maybe a
Nothing,
      event_context :: Maybe Text
event_context = Maybe Text
forall a. Maybe a
Nothing,
      event_groupingHash :: Maybe Text
event_groupingHash = Maybe Text
forall a. Maybe a
Nothing,
      event_unhandled :: Maybe Bool
event_unhandled = Maybe Bool
forall a. Maybe a
Nothing,
      event_severity :: Maybe Severity
event_severity = Maybe Severity
forall a. Maybe a
Nothing,
      event_severityReason :: Maybe SeverityReason
event_severityReason = Maybe SeverityReason
forall a. Maybe a
Nothing,
      event_user :: Maybe User
event_user = Maybe User
forall a. Maybe a
Nothing,
      event_app :: Maybe App
event_app = Maybe App
forall a. Maybe a
Nothing,
      event_device :: Maybe Device
event_device = Maybe Device
forall a. Maybe a
Nothing,
      event_session :: Maybe Session
event_session = Maybe Session
forall a. Maybe a
Nothing,
      event_metaData :: Maybe Object
event_metaData = Maybe Object
forall a. Maybe a
Nothing
    }

-- | An exception that occurred during this event.
data Exception = Exception
  { -- | The class of error which occurred. This field is used to group the errors together so should not contain any contextual information that would prevent correct grouping. This would ordinarily be the Exception name when dealing with an exception.
    Exception -> Text
exception_errorClass :: Text,
    -- | The error message associated with the error. Usually this will contain some information about this specific instance of the error and is not used to group the errors.
    Exception -> Maybe Text
exception_message :: Maybe Text,
    -- | An array of stackframe objects. Each object represents one line in the exception's stacktrace. Bugsnag uses this information to help with error grouping, as well as displaying it to the user.
    Exception -> [StackFrame]
exception_stacktrace :: [StackFrame],
    -- | This should be set for the following platforms so that the stacktrace can be parsed correctly:
    Exception -> Maybe ExceptionType
exception_type :: Maybe ExceptionType
  }
  deriving ((forall x. Exception -> Rep Exception x)
-> (forall x. Rep Exception x -> Exception) -> Generic Exception
forall x. Rep Exception x -> Exception
forall x. Exception -> Rep Exception x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Exception x -> Exception
$cfrom :: forall x. Exception -> Rep Exception x
Generic, Int -> Exception -> ShowS
[Exception] -> ShowS
Exception -> String
(Int -> Exception -> ShowS)
-> (Exception -> String)
-> ([Exception] -> ShowS)
-> Show Exception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exception] -> ShowS
$cshowList :: [Exception] -> ShowS
show :: Exception -> String
$cshow :: Exception -> String
showsPrec :: Int -> Exception -> ShowS
$cshowsPrec :: Int -> Exception -> ShowS
Show)

instance Data.Aeson.ToJSON Exception where
  toJSON :: Exception -> Value
toJSON = Options -> Exception -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Exception -> Encoding
toEncoding = Options -> Exception -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Exception where
  parseJSON :: Value -> Parser Exception
parseJSON = Options -> Value -> Parser Exception
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default exception.
defaultException :: Exception
defaultException :: Exception
defaultException =
  Exception :: Text
-> Maybe Text -> [StackFrame] -> Maybe ExceptionType -> Exception
Exception
    { exception_errorClass :: Text
exception_errorClass = Text
"",
      exception_message :: Maybe Text
exception_message = Maybe Text
forall a. Maybe a
Nothing,
      exception_stacktrace :: [StackFrame]
exception_stacktrace = [],
      exception_type :: Maybe ExceptionType
exception_type = Maybe ExceptionType
forall a. Maybe a
Nothing
    }

-- | Each stackrame represents one line in the exception's stacktrace. Bugsnag uses this information to help with error grouping, as well as displaying it to the user.
data StackFrame = StackFrame
  { -- | The file that this stack frame was executing. It is recommended that you strip any unnecessary or common information from the beginning of the path.
    StackFrame -> Text
stackFrame_file :: Text,
    -- | The line of the file that this frame of the stack was in.
    StackFrame -> Int
stackFrame_lineNumber :: Int,
    -- | The column of the file that this frame of the stack was in.
    StackFrame -> Maybe Int
stackFrame_columnNumber :: Maybe Int,
    -- | The method that this particular stack frame is within.
    StackFrame -> Text
stackFrame_method :: Text,
    -- | If this stacktrace line is in the user's project code, set this to true. It is useful for developers to be able to see which lines of a stacktrace are within their own application, and which are within third party libraries. This boolean field allows Bugsnag to display this information in the stacktrace as well as use the information to help group errors better.
    StackFrame -> Maybe Bool
stackFrame_inProject :: Maybe Bool,
    -- | The code in this file surrounding this line. This is an object containing key value pairs where each key is a line number and each value is the code from that line. You can include up to three lines on either side of the line where the error occurred. These will be displayed on the bugsnag dashboard when you expand that line.
    StackFrame -> Maybe (HashMap Int Text)
stackFrame_code :: Maybe (HashMap Int Text)
  }
  deriving ((forall x. StackFrame -> Rep StackFrame x)
-> (forall x. Rep StackFrame x -> StackFrame) -> Generic StackFrame
forall x. Rep StackFrame x -> StackFrame
forall x. StackFrame -> Rep StackFrame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StackFrame x -> StackFrame
$cfrom :: forall x. StackFrame -> Rep StackFrame x
Generic, Int -> StackFrame -> ShowS
[StackFrame] -> ShowS
StackFrame -> String
(Int -> StackFrame -> ShowS)
-> (StackFrame -> String)
-> ([StackFrame] -> ShowS)
-> Show StackFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackFrame] -> ShowS
$cshowList :: [StackFrame] -> ShowS
show :: StackFrame -> String
$cshow :: StackFrame -> String
showsPrec :: Int -> StackFrame -> ShowS
$cshowsPrec :: Int -> StackFrame -> ShowS
Show)

instance Data.Aeson.ToJSON StackFrame where
  toJSON :: StackFrame -> Value
toJSON = Options -> StackFrame -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: StackFrame -> Encoding
toEncoding = Options -> StackFrame -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON StackFrame where
  parseJSON :: Value -> Parser StackFrame
parseJSON = Options -> Value -> Parser StackFrame
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default stackFrame.
defaultStackFrame :: StackFrame
defaultStackFrame :: StackFrame
defaultStackFrame =
  StackFrame :: Text
-> Int
-> Maybe Int
-> Text
-> Maybe Bool
-> Maybe (HashMap Int Text)
-> StackFrame
StackFrame
    { stackFrame_file :: Text
stackFrame_file = Text
"",
      stackFrame_lineNumber :: Int
stackFrame_lineNumber = Int
0,
      stackFrame_columnNumber :: Maybe Int
stackFrame_columnNumber = Maybe Int
forall a. Maybe a
Nothing,
      stackFrame_method :: Text
stackFrame_method = Text
"",
      stackFrame_inProject :: Maybe Bool
stackFrame_inProject = Maybe Bool
forall a. Maybe a
Nothing,
      stackFrame_code :: Maybe (HashMap Int Text)
stackFrame_code = Maybe (HashMap Int Text)
forall a. Maybe a
Nothing
    }

-- | This should be set for the following platforms so that the stacktrace can be parsed correctly:
newtype ExceptionType = ExceptionType Text
  deriving ((forall x. ExceptionType -> Rep ExceptionType x)
-> (forall x. Rep ExceptionType x -> ExceptionType)
-> Generic ExceptionType
forall x. Rep ExceptionType x -> ExceptionType
forall x. ExceptionType -> Rep ExceptionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExceptionType x -> ExceptionType
$cfrom :: forall x. ExceptionType -> Rep ExceptionType x
Generic, Int -> ExceptionType -> ShowS
[ExceptionType] -> ShowS
ExceptionType -> String
(Int -> ExceptionType -> ShowS)
-> (ExceptionType -> String)
-> ([ExceptionType] -> ShowS)
-> Show ExceptionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExceptionType] -> ShowS
$cshowList :: [ExceptionType] -> ShowS
show :: ExceptionType -> String
$cshow :: ExceptionType -> String
showsPrec :: Int -> ExceptionType -> ShowS
$cshowsPrec :: Int -> ExceptionType -> ShowS
Show)

instance Data.Aeson.ToJSON ExceptionType where
  toJSON :: ExceptionType -> Value
toJSON = Options -> ExceptionType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: ExceptionType -> Encoding
toEncoding = Options -> ExceptionType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON ExceptionType where
  parseJSON :: Value -> Parser ExceptionType
parseJSON = Options -> Value -> Parser ExceptionType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | For cocoa (iOS/tvOS/macOS)
cocoaExceptionType :: ExceptionType
cocoaExceptionType :: ExceptionType
cocoaExceptionType = Text -> ExceptionType
ExceptionType Text
"cocoa"

-- | For android
androidExceptionType :: ExceptionType
androidExceptionType :: ExceptionType
androidExceptionType = Text -> ExceptionType
ExceptionType Text
"android"

-- | For browser-based JavaScript
browserjsExceptionType :: ExceptionType
browserjsExceptionType :: ExceptionType
browserjsExceptionType = Text -> ExceptionType
ExceptionType Text
"browserjs"

-- | For JavaScript in Expo
expojsExceptionType :: ExceptionType
expojsExceptionType :: ExceptionType
expojsExceptionType = Text -> ExceptionType
ExceptionType Text
"expojs"

-- | For JavaScript in Node
nodejsExceptionType :: ExceptionType
nodejsExceptionType :: ExceptionType
nodejsExceptionType = Text -> ExceptionType
ExceptionType Text
"nodejs"

-- | User- and system-initiated event which led up to an error, providing additional context.
data Breadcrumb = Breadcrumb
  { -- | The time at which the event occurred, in [ISO 8601 format](https://tools.ietf.org/html/rfc3339#section-5.8).
    Breadcrumb -> Text
breadcrumb_timestamp :: Text,
    -- | A short summary describing the event, such as the user action taken or a new application state.
    Breadcrumb -> Text
breadcrumb_name :: Text,
    -- | A category which describes the breadcrumb, from the list of allowed values.
    Breadcrumb -> BreadcrumbType
breadcrumb_type :: BreadcrumbType,
    -- | Additional information about the event, as key/value pairs.
    Breadcrumb -> Maybe (HashMap Text Text)
breadcrumb_metaData :: Maybe (HashMap Text Text)
  }
  deriving ((forall x. Breadcrumb -> Rep Breadcrumb x)
-> (forall x. Rep Breadcrumb x -> Breadcrumb) -> Generic Breadcrumb
forall x. Rep Breadcrumb x -> Breadcrumb
forall x. Breadcrumb -> Rep Breadcrumb x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Breadcrumb x -> Breadcrumb
$cfrom :: forall x. Breadcrumb -> Rep Breadcrumb x
Generic, Int -> Breadcrumb -> ShowS
[Breadcrumb] -> ShowS
Breadcrumb -> String
(Int -> Breadcrumb -> ShowS)
-> (Breadcrumb -> String)
-> ([Breadcrumb] -> ShowS)
-> Show Breadcrumb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Breadcrumb] -> ShowS
$cshowList :: [Breadcrumb] -> ShowS
show :: Breadcrumb -> String
$cshow :: Breadcrumb -> String
showsPrec :: Int -> Breadcrumb -> ShowS
$cshowsPrec :: Int -> Breadcrumb -> ShowS
Show)

instance Data.Aeson.ToJSON Breadcrumb where
  toJSON :: Breadcrumb -> Value
toJSON = Options -> Breadcrumb -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Breadcrumb -> Encoding
toEncoding = Options -> Breadcrumb -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Breadcrumb where
  parseJSON :: Value -> Parser Breadcrumb
parseJSON = Options -> Value -> Parser Breadcrumb
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default breadcrumb.
defaultBreadcrumb :: Breadcrumb
defaultBreadcrumb :: Breadcrumb
defaultBreadcrumb =
  Breadcrumb :: Text
-> Text
-> BreadcrumbType
-> Maybe (HashMap Text Text)
-> Breadcrumb
Breadcrumb
    { breadcrumb_timestamp :: Text
breadcrumb_timestamp = Text
"",
      breadcrumb_name :: Text
breadcrumb_name = Text
"",
      breadcrumb_type :: BreadcrumbType
breadcrumb_type = BreadcrumbType
navigationBreadcrumbType,
      breadcrumb_metaData :: Maybe (HashMap Text Text)
breadcrumb_metaData = Maybe (HashMap Text Text)
forall a. Maybe a
Nothing
    }

-- | A category which describes the breadcrumb, from the list of allowed values.
newtype BreadcrumbType = BreadcrumbType Text
  deriving ((forall x. BreadcrumbType -> Rep BreadcrumbType x)
-> (forall x. Rep BreadcrumbType x -> BreadcrumbType)
-> Generic BreadcrumbType
forall x. Rep BreadcrumbType x -> BreadcrumbType
forall x. BreadcrumbType -> Rep BreadcrumbType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BreadcrumbType x -> BreadcrumbType
$cfrom :: forall x. BreadcrumbType -> Rep BreadcrumbType x
Generic, Int -> BreadcrumbType -> ShowS
[BreadcrumbType] -> ShowS
BreadcrumbType -> String
(Int -> BreadcrumbType -> ShowS)
-> (BreadcrumbType -> String)
-> ([BreadcrumbType] -> ShowS)
-> Show BreadcrumbType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BreadcrumbType] -> ShowS
$cshowList :: [BreadcrumbType] -> ShowS
show :: BreadcrumbType -> String
$cshow :: BreadcrumbType -> String
showsPrec :: Int -> BreadcrumbType -> ShowS
$cshowsPrec :: Int -> BreadcrumbType -> ShowS
Show)

instance Data.Aeson.ToJSON BreadcrumbType where
  toJSON :: BreadcrumbType -> Value
toJSON = Options -> BreadcrumbType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: BreadcrumbType -> Encoding
toEncoding = Options -> BreadcrumbType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON BreadcrumbType where
  parseJSON :: Value -> Parser BreadcrumbType
parseJSON = Options -> Value -> Parser BreadcrumbType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | Changing screens or content being displayed, with a defined destination and optionally a previous location.
navigationBreadcrumbType :: BreadcrumbType
navigationBreadcrumbType :: BreadcrumbType
navigationBreadcrumbType = Text -> BreadcrumbType
BreadcrumbType Text
"navigation"

-- | Sending and receiving requests and responses.
requestBreadcrumbType :: BreadcrumbType
requestBreadcrumbType :: BreadcrumbType
requestBreadcrumbType = Text -> BreadcrumbType
BreadcrumbType Text
"request"

-- | Performing an intensive task or query.
processBreadcrumbType :: BreadcrumbType
processBreadcrumbType :: BreadcrumbType
processBreadcrumbType = Text -> BreadcrumbType
BreadcrumbType Text
"process"

-- | Messages and severity sent to a logging platform.
logBreadcrumbType :: BreadcrumbType
logBreadcrumbType :: BreadcrumbType
logBreadcrumbType = Text -> BreadcrumbType
BreadcrumbType Text
"log"

-- | Actions performed by the user, like text input, button presses, or confirming/cancelling an alert dialog.
userBreadcrumbType :: BreadcrumbType
userBreadcrumbType :: BreadcrumbType
userBreadcrumbType = Text -> BreadcrumbType
BreadcrumbType Text
"user"

-- | Changing the overall state of an app, such as closing, pausing, or being moved to the background, as well as device state changes like memory or battery warnings and network connectivity changes.
stateBreadcrumbType :: BreadcrumbType
stateBreadcrumbType :: BreadcrumbType
stateBreadcrumbType = Text -> BreadcrumbType
BreadcrumbType Text
"state"

-- | An error which was reported to Bugsnag encountered in the same session.
errorBreadcrumbType :: BreadcrumbType
errorBreadcrumbType :: BreadcrumbType
errorBreadcrumbType = Text -> BreadcrumbType
BreadcrumbType Text
"error"

-- | User-defined, manually added breadcrumbs.
manualBreadcrumbType :: BreadcrumbType
manualBreadcrumbType :: BreadcrumbType
manualBreadcrumbType = Text -> BreadcrumbType
BreadcrumbType Text
"manual"

-- | Details about the web request from the client that experienced the error, if relevant. To display custom request data alongside these standard fields on the Bugsnag website, the custom data should be included in the metaData object in a request object.
data Request = Request
  { -- | The IP address of the client that experienced the error.
    Request -> Maybe Text
request_clientIp :: Maybe Text,
    -- | The headers sent with the request.
    Request -> Maybe (HashMap Text Text)
request_headers :: Maybe (HashMap Text Text),
    -- | The HTTP method used.
    Request -> Maybe Text
request_httpMethod :: Maybe Text,
    -- | The URL of the request.
    Request -> Maybe Text
request_url :: Maybe Text,
    -- | The [HTTP referer](https://en.wikipedia.org/wiki/HTTP_referer)
    Request -> Maybe Text
request_referer :: Maybe Text
  }
  deriving ((forall x. Request -> Rep Request x)
-> (forall x. Rep Request x -> Request) -> Generic Request
forall x. Rep Request x -> Request
forall x. Request -> Rep Request x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Request x -> Request
$cfrom :: forall x. Request -> Rep Request x
Generic, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

instance Data.Aeson.ToJSON Request where
  toJSON :: Request -> Value
toJSON = Options -> Request -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Request -> Encoding
toEncoding = Options -> Request -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Request where
  parseJSON :: Value -> Parser Request
parseJSON = Options -> Value -> Parser Request
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default request.
defaultRequest :: Request
defaultRequest :: Request
defaultRequest =
  Request :: Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Request
Request
    { request_clientIp :: Maybe Text
request_clientIp = Maybe Text
forall a. Maybe a
Nothing,
      request_headers :: Maybe (HashMap Text Text)
request_headers = Maybe (HashMap Text Text)
forall a. Maybe a
Nothing,
      request_httpMethod :: Maybe Text
request_httpMethod = Maybe Text
forall a. Maybe a
Nothing,
      request_url :: Maybe Text
request_url = Maybe Text
forall a. Maybe a
Nothing,
      request_referer :: Maybe Text
request_referer = Maybe Text
forall a. Maybe a
Nothing
    }

-- | An array of background threads. This is optional but recommended for apps that rely heavily on threading. Threads should be in an order that makes sense for your application.
data Thread = Thread
  { -- | The id of the thread in your application.
    Thread -> Maybe Text
thread_id :: Maybe Text,
    -- | A human readable name for the thread.
    Thread -> Maybe Text
thread_name :: Maybe Text,
    -- | If this is the thread that the error was reported from (either an unhandled error or a call to bugsnag.notify), set this to true.
    Thread -> Maybe Bool
thread_errorReportingThread :: Maybe Bool,
    -- | An array of stacktrace objects. Each object represents one line in the stacktrace of the thread at the point that the error occurred.
    Thread -> Maybe [StackFrame]
thread_stacktrace :: Maybe [StackFrame],
    -- | Setting this allows the stacktrace to be parsed correctly.
    Thread -> Maybe ThreadType
thread_type :: Maybe ThreadType
  }
  deriving ((forall x. Thread -> Rep Thread x)
-> (forall x. Rep Thread x -> Thread) -> Generic Thread
forall x. Rep Thread x -> Thread
forall x. Thread -> Rep Thread x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Thread x -> Thread
$cfrom :: forall x. Thread -> Rep Thread x
Generic, Int -> Thread -> ShowS
[Thread] -> ShowS
Thread -> String
(Int -> Thread -> ShowS)
-> (Thread -> String) -> ([Thread] -> ShowS) -> Show Thread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Thread] -> ShowS
$cshowList :: [Thread] -> ShowS
show :: Thread -> String
$cshow :: Thread -> String
showsPrec :: Int -> Thread -> ShowS
$cshowsPrec :: Int -> Thread -> ShowS
Show)

instance Data.Aeson.ToJSON Thread where
  toJSON :: Thread -> Value
toJSON = Options -> Thread -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Thread -> Encoding
toEncoding = Options -> Thread -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Thread where
  parseJSON :: Value -> Parser Thread
parseJSON = Options -> Value -> Parser Thread
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default thread.
defaultThread :: Thread
defaultThread :: Thread
defaultThread =
  Thread :: Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [StackFrame]
-> Maybe ThreadType
-> Thread
Thread
    { thread_id :: Maybe Text
thread_id = Maybe Text
forall a. Maybe a
Nothing,
      thread_name :: Maybe Text
thread_name = Maybe Text
forall a. Maybe a
Nothing,
      thread_errorReportingThread :: Maybe Bool
thread_errorReportingThread = Maybe Bool
forall a. Maybe a
Nothing,
      thread_stacktrace :: Maybe [StackFrame]
thread_stacktrace = Maybe [StackFrame]
forall a. Maybe a
Nothing,
      thread_type :: Maybe ThreadType
thread_type = Maybe ThreadType
forall a. Maybe a
Nothing
    }

-- | Used for parsing the stack trace correctly.
newtype ThreadType = ThreadType Text
  deriving ((forall x. ThreadType -> Rep ThreadType x)
-> (forall x. Rep ThreadType x -> ThreadType) -> Generic ThreadType
forall x. Rep ThreadType x -> ThreadType
forall x. ThreadType -> Rep ThreadType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ThreadType x -> ThreadType
$cfrom :: forall x. ThreadType -> Rep ThreadType x
Generic, Int -> ThreadType -> ShowS
[ThreadType] -> ShowS
ThreadType -> String
(Int -> ThreadType -> ShowS)
-> (ThreadType -> String)
-> ([ThreadType] -> ShowS)
-> Show ThreadType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadType] -> ShowS
$cshowList :: [ThreadType] -> ShowS
show :: ThreadType -> String
$cshow :: ThreadType -> String
showsPrec :: Int -> ThreadType -> ShowS
$cshowsPrec :: Int -> ThreadType -> ShowS
Show)

instance Data.Aeson.ToJSON ThreadType where
  toJSON :: ThreadType -> Value
toJSON = Options -> ThreadType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: ThreadType -> Encoding
toEncoding = Options -> ThreadType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON ThreadType where
  parseJSON :: Value -> Parser ThreadType
parseJSON = Options -> Value -> Parser ThreadType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | For cocoa (iOS/tvOS/macOS)
cocoaThreadType :: ThreadType
cocoaThreadType :: ThreadType
cocoaThreadType = Text -> ThreadType
ThreadType Text
"cocoa"

-- | For android
androidThreadType :: ThreadType
androidThreadType :: ThreadType
androidThreadType = Text -> ThreadType
ThreadType Text
"android"

-- | For browser-based JavaScript
browserjsThreadType :: ThreadType
browserjsThreadType :: ThreadType
browserjsThreadType = Text -> ThreadType
ThreadType Text
"browserjs"

-- | The severity of the error
newtype Severity = Severity Text
  deriving ((forall x. Severity -> Rep Severity x)
-> (forall x. Rep Severity x -> Severity) -> Generic Severity
forall x. Rep Severity x -> Severity
forall x. Severity -> Rep Severity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Severity x -> Severity
$cfrom :: forall x. Severity -> Rep Severity x
Generic, Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show)

instance Data.Aeson.ToJSON Severity where
  toJSON :: Severity -> Value
toJSON = Options -> Severity -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Severity -> Encoding
toEncoding = Options -> Severity -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Severity where
  parseJSON :: Value -> Parser Severity
parseJSON = Options -> Value -> Parser Severity
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | The default for unhandled errors.
errorSeverity :: Severity
errorSeverity :: Severity
errorSeverity = Text -> Severity
Severity Text
"error"

-- | The default when Bugsnag.notify is called.
warningSeverity :: Severity
warningSeverity :: Severity
warningSeverity = Text -> Severity
Severity Text
"warning"

-- | Can be used in manual Bugsnag.notify calls.
infoSeverity :: Severity
infoSeverity :: Severity
infoSeverity = Text -> Severity
Severity Text
"info"

-- | Information about why the severity was picked.
data SeverityReason = SeverityReason
  { -- | A type key that represents the reason for the assigned severity.
    SeverityReason -> SeverityReasonType
severityReason_type :: SeverityReasonType,
    -- | Optional attributes to provide extra information about the severity reason.
    SeverityReason -> SeverityReasonAttributes
severityReason_attributes :: SeverityReasonAttributes
  }
  deriving ((forall x. SeverityReason -> Rep SeverityReason x)
-> (forall x. Rep SeverityReason x -> SeverityReason)
-> Generic SeverityReason
forall x. Rep SeverityReason x -> SeverityReason
forall x. SeverityReason -> Rep SeverityReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeverityReason x -> SeverityReason
$cfrom :: forall x. SeverityReason -> Rep SeverityReason x
Generic, Int -> SeverityReason -> ShowS
[SeverityReason] -> ShowS
SeverityReason -> String
(Int -> SeverityReason -> ShowS)
-> (SeverityReason -> String)
-> ([SeverityReason] -> ShowS)
-> Show SeverityReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeverityReason] -> ShowS
$cshowList :: [SeverityReason] -> ShowS
show :: SeverityReason -> String
$cshow :: SeverityReason -> String
showsPrec :: Int -> SeverityReason -> ShowS
$cshowsPrec :: Int -> SeverityReason -> ShowS
Show)

instance Data.Aeson.ToJSON SeverityReason where
  toJSON :: SeverityReason -> Value
toJSON = Options -> SeverityReason -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: SeverityReason -> Encoding
toEncoding = Options -> SeverityReason -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON SeverityReason where
  parseJSON :: Value -> Parser SeverityReason
parseJSON = Options -> Value -> Parser SeverityReason
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default severityReason.
defaultSeverityReason :: SeverityReason
defaultSeverityReason :: SeverityReason
defaultSeverityReason =
  SeverityReason :: SeverityReasonType -> SeverityReasonAttributes -> SeverityReason
SeverityReason
    { severityReason_type :: SeverityReasonType
severityReason_type = SeverityReasonType
unhandledExceptionSeverityReasonType,
      severityReason_attributes :: SeverityReasonAttributes
severityReason_attributes = SeverityReasonAttributes
defaultSeverityReasonAttributes
    }

-- | A type key that represents the reason for the assigned severity.
newtype SeverityReasonType = SeverityReasonType Text
  deriving ((forall x. SeverityReasonType -> Rep SeverityReasonType x)
-> (forall x. Rep SeverityReasonType x -> SeverityReasonType)
-> Generic SeverityReasonType
forall x. Rep SeverityReasonType x -> SeverityReasonType
forall x. SeverityReasonType -> Rep SeverityReasonType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeverityReasonType x -> SeverityReasonType
$cfrom :: forall x. SeverityReasonType -> Rep SeverityReasonType x
Generic, Int -> SeverityReasonType -> ShowS
[SeverityReasonType] -> ShowS
SeverityReasonType -> String
(Int -> SeverityReasonType -> ShowS)
-> (SeverityReasonType -> String)
-> ([SeverityReasonType] -> ShowS)
-> Show SeverityReasonType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeverityReasonType] -> ShowS
$cshowList :: [SeverityReasonType] -> ShowS
show :: SeverityReasonType -> String
$cshow :: SeverityReasonType -> String
showsPrec :: Int -> SeverityReasonType -> ShowS
$cshowsPrec :: Int -> SeverityReasonType -> ShowS
Show)

instance Data.Aeson.ToJSON SeverityReasonType where
  toJSON :: SeverityReasonType -> Value
toJSON = Options -> SeverityReasonType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: SeverityReasonType -> Encoding
toEncoding = Options -> SeverityReasonType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON SeverityReasonType where
  parseJSON :: Value -> Parser SeverityReasonType
parseJSON = Options -> Value -> Parser SeverityReasonType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | Whenever an uncaught exception is discovered (generic).
unhandledExceptionSeverityReasonType :: SeverityReasonType
unhandledExceptionSeverityReasonType :: SeverityReasonType
unhandledExceptionSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"unhandledException"

-- | When an error is discovered (PHP).
unhandledErrorSeverityReasonType :: SeverityReasonType
unhandledErrorSeverityReasonType :: SeverityReasonType
unhandledErrorSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"unhandledError"

-- | Whenever a log message is sent (generic).
logSeverityReasonType :: SeverityReasonType
logSeverityReasonType :: SeverityReasonType
logSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"log"

-- | Whenever a "fatal" signal is discovered (iOS).
signalSeverityReasonType :: SeverityReasonType
signalSeverityReasonType :: SeverityReasonType
signalSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"signal"

-- | Whenever a strictMode issue is discovered (Android).
strictModeSeverityReasonType :: SeverityReasonType
strictModeSeverityReasonType :: SeverityReasonType
strictModeSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"strictMode"

-- | Whenever an unhandled promise rejection is discovered (JS/Node JS/React Native).
unhandledPromiseRejectionSeverityReasonType :: SeverityReasonType
unhandledPromiseRejectionSeverityReasonType :: SeverityReasonType
unhandledPromiseRejectionSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"unhandledPromiseRejection"

-- | callbackErrorIntercept (Node JS).
callbackErrorInterceptSeverityReasonType :: SeverityReasonType
callbackErrorInterceptSeverityReasonType :: SeverityReasonType
callbackErrorInterceptSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"callbackErrorIntercept"

-- | Whenever an exception with a particular class is automatically sent (Ruby).
errorClassSeverityReasonType :: SeverityReasonType
errorClassSeverityReasonType :: SeverityReasonType
errorClassSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"errorClass"

-- | When a panic is unhandled and crashes the app (Go).
unhandledPanicSeverityReasonType :: SeverityReasonType
unhandledPanicSeverityReasonType :: SeverityReasonType
unhandledPanicSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"unhandledPanic"

-- | Whenever a callback changes a report's severity (generic).
userCallbackSetSeveritySeverityReasonType :: SeverityReasonType
userCallbackSetSeveritySeverityReasonType :: SeverityReasonType
userCallbackSetSeveritySeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"userCallbackSetSeverity"

-- | Whenever a severity is set through a manual notify call (generic).
userSpecifiedSeveritySeverityReasonType :: SeverityReasonType
userSpecifiedSeveritySeverityReasonType :: SeverityReasonType
userSpecifiedSeveritySeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"userSpecifiedSeverity"

-- | Whenever a handled exception is sent through (generic).
handledExceptionSeverityReasonType :: SeverityReasonType
handledExceptionSeverityReasonType :: SeverityReasonType
handledExceptionSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"handledException"

-- | Whenever a handled error is sent through (PHP).
handledErrorSeverityReasonType :: SeverityReasonType
handledErrorSeverityReasonType :: SeverityReasonType
handledErrorSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"handledError"

-- | Whenever a panic is handled through AutoNotify or Recover (Go).
handledPanicSeverityReasonType :: SeverityReasonType
handledPanicSeverityReasonType :: SeverityReasonType
handledPanicSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"handledPanic"

-- | Whenever a panic is handled through AutoNotify or Recover (Go).
userContextSetSeveritySeverityReasonType :: SeverityReasonType
userContextSetSeveritySeverityReasonType :: SeverityReasonType
userContextSetSeveritySeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"userContextSetSeverity"

-- | Whenever an ANR is detected (Android).
anrErrorSeverityReasonType :: SeverityReasonType
anrErrorSeverityReasonType :: SeverityReasonType
anrErrorSeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"anrError"

-- | When an app is terminated because it used too much memory (Cocoa).
outOfMemorySeverityReasonType :: SeverityReasonType
outOfMemorySeverityReasonType :: SeverityReasonType
outOfMemorySeverityReasonType = Text -> SeverityReasonType
SeverityReasonType Text
"outOfMemory"

-- | Optional attributes to provide extra information about the severity reason.
data SeverityReasonAttributes = SeverityReasonAttributes
  { -- | Included for unhandledError severity reason. See [PHP Error Constants](https://www.php.net/manual/en/errorfunc.constants.php).
    SeverityReasonAttributes -> Maybe Text
severityReasonAttributes_errorType :: Maybe Text,
    -- | Included for log severity reason.
    SeverityReasonAttributes -> Maybe Text
severityReasonAttributes_level :: Maybe Text,
    -- | Included for signal severity reason. See [Signal Codes](https://en.wikipedia.org/wiki/C_signal_handling).
    SeverityReasonAttributes -> Maybe Text
severityReasonAttributes_signalType :: Maybe Text,
    -- | Included for strictMode severity reason. See [Strict Mode](https://developer.android.com/reference/android/os/StrictMode.html).
    SeverityReasonAttributes -> Maybe Text
severityReasonAttributes_violationType :: Maybe Text,
    -- | Included for errorClass severity reason. Specifies the error class that is automatically sent.
    SeverityReasonAttributes -> Maybe Text
severityReasonAttributes_errorClass :: Maybe Text
  }
  deriving ((forall x.
 SeverityReasonAttributes -> Rep SeverityReasonAttributes x)
-> (forall x.
    Rep SeverityReasonAttributes x -> SeverityReasonAttributes)
-> Generic SeverityReasonAttributes
forall x.
Rep SeverityReasonAttributes x -> SeverityReasonAttributes
forall x.
SeverityReasonAttributes -> Rep SeverityReasonAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SeverityReasonAttributes x -> SeverityReasonAttributes
$cfrom :: forall x.
SeverityReasonAttributes -> Rep SeverityReasonAttributes x
Generic, Int -> SeverityReasonAttributes -> ShowS
[SeverityReasonAttributes] -> ShowS
SeverityReasonAttributes -> String
(Int -> SeverityReasonAttributes -> ShowS)
-> (SeverityReasonAttributes -> String)
-> ([SeverityReasonAttributes] -> ShowS)
-> Show SeverityReasonAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeverityReasonAttributes] -> ShowS
$cshowList :: [SeverityReasonAttributes] -> ShowS
show :: SeverityReasonAttributes -> String
$cshow :: SeverityReasonAttributes -> String
showsPrec :: Int -> SeverityReasonAttributes -> ShowS
$cshowsPrec :: Int -> SeverityReasonAttributes -> ShowS
Show)

instance Data.Aeson.ToJSON SeverityReasonAttributes where
  toJSON :: SeverityReasonAttributes -> Value
toJSON = Options -> SeverityReasonAttributes -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: SeverityReasonAttributes -> Encoding
toEncoding = Options -> SeverityReasonAttributes -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON SeverityReasonAttributes where
  parseJSON :: Value -> Parser SeverityReasonAttributes
parseJSON = Options -> Value -> Parser SeverityReasonAttributes
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default severityReasonAttributes.
defaultSeverityReasonAttributes :: SeverityReasonAttributes
defaultSeverityReasonAttributes :: SeverityReasonAttributes
defaultSeverityReasonAttributes =
  SeverityReasonAttributes :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> SeverityReasonAttributes
SeverityReasonAttributes
    { severityReasonAttributes_errorType :: Maybe Text
severityReasonAttributes_errorType = Maybe Text
forall a. Maybe a
Nothing,
      severityReasonAttributes_level :: Maybe Text
severityReasonAttributes_level = Maybe Text
forall a. Maybe a
Nothing,
      severityReasonAttributes_signalType :: Maybe Text
severityReasonAttributes_signalType = Maybe Text
forall a. Maybe a
Nothing,
      severityReasonAttributes_violationType :: Maybe Text
severityReasonAttributes_violationType = Maybe Text
forall a. Maybe a
Nothing,
      severityReasonAttributes_errorClass :: Maybe Text
severityReasonAttributes_errorClass = Maybe Text
forall a. Maybe a
Nothing
    }

-- | Information about the user affected by the error. These fields are optional but highly recommended. To display custom user data alongside these standard fields on the Bugsnag website, the custom data should be included in the metaData object in a user object.
data User = User
  { -- | A unique identifier for a user affected by this event. This could be any distinct identifier that makes sense for your application/platform.
    User -> Maybe Text
user_id :: Maybe Text,
    -- | The user's name, or a string you use to identify them.
    User -> Maybe Text
user_name :: Maybe Text,
    -- | The user's email address.
    User -> Maybe Text
user_email :: Maybe Text
  }
  deriving ((forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep User x -> User
$cfrom :: forall x. User -> Rep User x
Generic, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show)

instance Data.Aeson.ToJSON User where
  toJSON :: User -> Value
toJSON = Options -> User -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: User -> Encoding
toEncoding = Options -> User -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON User where
  parseJSON :: Value -> Parser User
parseJSON = Options -> Value -> Parser User
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default user.
defaultUser :: User
defaultUser :: User
defaultUser =
  User :: Maybe Text -> Maybe Text -> Maybe Text -> User
User
    { user_id :: Maybe Text
user_id = Maybe Text
forall a. Maybe a
Nothing,
      user_name :: Maybe Text
user_name = Maybe Text
forall a. Maybe a
Nothing,
      user_email :: Maybe Text
user_email = Maybe Text
forall a. Maybe a
Nothing
    }

-- | Information about the app where the error occurred. These fields are optional but highly recommended. To display custom app data alongside these standard fields on the Bugsnag website, the custom data should be included in the metaData object in an app object.
data App = App
  { -- | A unique ID for the application.
    App -> Maybe Text
app_id :: Maybe Text,
    -- | The version number of the application which generated the error.
    App -> Maybe Text
app_version :: Maybe Text,
    -- | The [version code](https://developer.android.com/studio/publish/versioning.html) of the application (Android only)
    App -> Maybe Int
app_versionCode :: Maybe Int,
    -- | The [bundle version/build number](https://developer.apple.com/library/archive/technotes/tn2420/_index.html) of the application (iOS/macOS/tvOS only)
    App -> Maybe Text
app_bundleVersion :: Maybe Text,
    -- | A unique identifier to identify a code bundle release when using tools like CodePush (mobile only).
    App -> Maybe Text
app_codeBundleId :: Maybe Text,
    -- | A build ID that is required to identify a specific build when the version and version code are the same.
    App -> Maybe Text
app_buildUUID :: Maybe Text,
    -- | The release stage that this error occurred in, for example "development", "staging" or "production".
    App -> Maybe Text
app_releaseStage :: Maybe Text,
    -- | A specialized type of the application, such as the worker queue or web framework used, like "rails", "mailman", or "celery".
    App -> Maybe Text
app_type :: Maybe Text,
    -- | The UUIDs of the [debug symbols file](http://lldb.llvm.org/symbols.html) corresponding to this application, if any.
    App -> Maybe [Text]
app_dsymUUIDs :: Maybe [Text],
    -- | How long the app has been running for in milliseconds.
    App -> Maybe Int
app_duration :: Maybe Int,
    -- | How long the app has been in the foreground of the device in milliseconds.
    App -> Maybe Int
app_durationInForeground :: Maybe Int,
    -- | Whether or not the app was in the foreground when the error occurred.
    App -> Maybe Bool
app_inForeground :: Maybe Bool,
    -- | The architecture of the running binary (Android only).
    App -> Maybe BinaryArch
app_binaryArch :: Maybe BinaryArch
  }
  deriving ((forall x. App -> Rep App x)
-> (forall x. Rep App x -> App) -> Generic App
forall x. Rep App x -> App
forall x. App -> Rep App x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep App x -> App
$cfrom :: forall x. App -> Rep App x
Generic, Int -> App -> ShowS
[App] -> ShowS
App -> String
(Int -> App -> ShowS)
-> (App -> String) -> ([App] -> ShowS) -> Show App
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [App] -> ShowS
$cshowList :: [App] -> ShowS
show :: App -> String
$cshow :: App -> String
showsPrec :: Int -> App -> ShowS
$cshowsPrec :: Int -> App -> ShowS
Show)

instance Data.Aeson.ToJSON App where
  toJSON :: App -> Value
toJSON = Options -> App -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: App -> Encoding
toEncoding = Options -> App -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON App where
  parseJSON :: Value -> Parser App
parseJSON = Options -> Value -> Parser App
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default app.
defaultApp :: App
defaultApp :: App
defaultApp =
  App :: Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe BinaryArch
-> App
App
    { app_id :: Maybe Text
app_id = Maybe Text
forall a. Maybe a
Nothing,
      app_version :: Maybe Text
app_version = Maybe Text
forall a. Maybe a
Nothing,
      app_versionCode :: Maybe Int
app_versionCode = Maybe Int
forall a. Maybe a
Nothing,
      app_bundleVersion :: Maybe Text
app_bundleVersion = Maybe Text
forall a. Maybe a
Nothing,
      app_codeBundleId :: Maybe Text
app_codeBundleId = Maybe Text
forall a. Maybe a
Nothing,
      app_buildUUID :: Maybe Text
app_buildUUID = Maybe Text
forall a. Maybe a
Nothing,
      app_releaseStage :: Maybe Text
app_releaseStage = Maybe Text
forall a. Maybe a
Nothing,
      app_type :: Maybe Text
app_type = Maybe Text
forall a. Maybe a
Nothing,
      app_dsymUUIDs :: Maybe [Text]
app_dsymUUIDs = Maybe [Text]
forall a. Maybe a
Nothing,
      app_duration :: Maybe Int
app_duration = Maybe Int
forall a. Maybe a
Nothing,
      app_durationInForeground :: Maybe Int
app_durationInForeground = Maybe Int
forall a. Maybe a
Nothing,
      app_inForeground :: Maybe Bool
app_inForeground = Maybe Bool
forall a. Maybe a
Nothing,
      app_binaryArch :: Maybe BinaryArch
app_binaryArch = Maybe BinaryArch
forall a. Maybe a
Nothing
    }

-- | The architecture of the running binary (Android only).
newtype BinaryArch = BinaryArch Text
  deriving ((forall x. BinaryArch -> Rep BinaryArch x)
-> (forall x. Rep BinaryArch x -> BinaryArch) -> Generic BinaryArch
forall x. Rep BinaryArch x -> BinaryArch
forall x. BinaryArch -> Rep BinaryArch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinaryArch x -> BinaryArch
$cfrom :: forall x. BinaryArch -> Rep BinaryArch x
Generic, Int -> BinaryArch -> ShowS
[BinaryArch] -> ShowS
BinaryArch -> String
(Int -> BinaryArch -> ShowS)
-> (BinaryArch -> String)
-> ([BinaryArch] -> ShowS)
-> Show BinaryArch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryArch] -> ShowS
$cshowList :: [BinaryArch] -> ShowS
show :: BinaryArch -> String
$cshow :: BinaryArch -> String
showsPrec :: Int -> BinaryArch -> ShowS
$cshowsPrec :: Int -> BinaryArch -> ShowS
Show)

instance Data.Aeson.ToJSON BinaryArch where
  toJSON :: BinaryArch -> Value
toJSON = Options -> BinaryArch -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: BinaryArch -> Encoding
toEncoding = Options -> BinaryArch -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON BinaryArch where
  parseJSON :: Value -> Parser BinaryArch
parseJSON = Options -> Value -> Parser BinaryArch
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | x86/i386 (32-bit).
x86BinaryArch :: BinaryArch
x86BinaryArch :: BinaryArch
x86BinaryArch = Text -> BinaryArch
BinaryArch Text
"x86"

-- | x86 (64-bit).
x86_64BinaryArch :: BinaryArch
x86_64BinaryArch :: BinaryArch
x86_64BinaryArch = Text -> BinaryArch
BinaryArch Text
"x86_64"

-- | armeabi/armeabi-v7a (32-bit).
arm32BinaryArch :: BinaryArch
arm32BinaryArch :: BinaryArch
arm32BinaryArch = Text -> BinaryArch
BinaryArch Text
"arm32"

-- | arm64-v8a (64-bit).
arm64BinaryArch :: BinaryArch
arm64BinaryArch :: BinaryArch
arm64BinaryArch = Text -> BinaryArch
BinaryArch Text
"arm64"

-- | Information about the computer/device running the app. These fields are optional but highly recommended. To display custom device data alongside these standard fields on the Bugsnag website, the custom data should be included in the metaData object in a device object.
data Device = Device
  { -- | The hostname of the server running your code, if applicable.
    Device -> Maybe Text
device_hostname :: Maybe Text,
    -- | A unique identifier for the device.
    Device -> Maybe Text
device_id :: Maybe Text,
    -- | The manufacturer of the device.
    Device -> Maybe Text
device_manufacturer :: Maybe Text,
    -- | The model of the device.
    Device -> Maybe Text
device_model :: Maybe Text,
    -- | The model number of the device.
    Device -> Maybe Text
device_modelNumber :: Maybe Text,
    -- | The device's operating system name.
    Device -> Maybe Text
device_osName :: Maybe Text,
    -- | The device's operating system version.
    Device -> Maybe Text
device_osVersion :: Maybe Text,
    -- | The number of bytes unused in the device's RAM.
    Device -> Maybe Int
device_freeMemory :: Maybe Int,
    -- | The number of total bytes in the device's RAM.
    Device -> Maybe Int
device_totalMemory :: Maybe Int,
    -- | The number of unused bytes on the drive running the application.
    Device -> Maybe Int
device_freeDisk :: Maybe Int,
    -- | If a web application, the web browser used by the device.
    Device -> Maybe Text
device_browserName :: Maybe Text,
    -- | If a web application, the version of the browser used by the device.
    Device -> Maybe Text
device_browserVersion :: Maybe Text,
    -- | Whether or not the device has been modified to give users root access.
    Device -> Maybe Bool
device_jailBroken :: Maybe Bool,
    -- | The orientation of the device at the time of the error.
    Device -> Maybe Text
device_orientation :: Maybe Text,
    -- | The time at which the error occurred, in [ISO 8601 format](https://tools.ietf.org/html/rfc3339#section-5.8).
    Device -> Maybe Text
device_time :: Maybe Text,
    -- | The ABIs supported by the device (Android only).
    Device -> Maybe [CpuAbi]
device_cpuAbi :: Maybe [CpuAbi],
    -- | The versions of the relevant runtimes, languages and/or frameworks for the platform.
    Device -> Maybe RuntimeVersions
device_runtimeVersions :: Maybe RuntimeVersions
  }
  deriving ((forall x. Device -> Rep Device x)
-> (forall x. Rep Device x -> Device) -> Generic Device
forall x. Rep Device x -> Device
forall x. Device -> Rep Device x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Device x -> Device
$cfrom :: forall x. Device -> Rep Device x
Generic, Int -> Device -> ShowS
[Device] -> ShowS
Device -> String
(Int -> Device -> ShowS)
-> (Device -> String) -> ([Device] -> ShowS) -> Show Device
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Device] -> ShowS
$cshowList :: [Device] -> ShowS
show :: Device -> String
$cshow :: Device -> String
showsPrec :: Int -> Device -> ShowS
$cshowsPrec :: Int -> Device -> ShowS
Show)

instance Data.Aeson.ToJSON Device where
  toJSON :: Device -> Value
toJSON = Options -> Device -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Device -> Encoding
toEncoding = Options -> Device -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Device where
  parseJSON :: Value -> Parser Device
parseJSON = Options -> Value -> Parser Device
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default device.
defaultDevice :: Device
defaultDevice :: Device
defaultDevice =
  Device :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe [CpuAbi]
-> Maybe RuntimeVersions
-> Device
Device
    { device_hostname :: Maybe Text
device_hostname = Maybe Text
forall a. Maybe a
Nothing,
      device_id :: Maybe Text
device_id = Maybe Text
forall a. Maybe a
Nothing,
      device_manufacturer :: Maybe Text
device_manufacturer = Maybe Text
forall a. Maybe a
Nothing,
      device_model :: Maybe Text
device_model = Maybe Text
forall a. Maybe a
Nothing,
      device_modelNumber :: Maybe Text
device_modelNumber = Maybe Text
forall a. Maybe a
Nothing,
      device_osName :: Maybe Text
device_osName = Maybe Text
forall a. Maybe a
Nothing,
      device_osVersion :: Maybe Text
device_osVersion = Maybe Text
forall a. Maybe a
Nothing,
      device_freeMemory :: Maybe Int
device_freeMemory = Maybe Int
forall a. Maybe a
Nothing,
      device_totalMemory :: Maybe Int
device_totalMemory = Maybe Int
forall a. Maybe a
Nothing,
      device_freeDisk :: Maybe Int
device_freeDisk = Maybe Int
forall a. Maybe a
Nothing,
      device_browserName :: Maybe Text
device_browserName = Maybe Text
forall a. Maybe a
Nothing,
      device_browserVersion :: Maybe Text
device_browserVersion = Maybe Text
forall a. Maybe a
Nothing,
      device_jailBroken :: Maybe Bool
device_jailBroken = Maybe Bool
forall a. Maybe a
Nothing,
      device_orientation :: Maybe Text
device_orientation = Maybe Text
forall a. Maybe a
Nothing,
      device_time :: Maybe Text
device_time = Maybe Text
forall a. Maybe a
Nothing,
      device_cpuAbi :: Maybe [CpuAbi]
device_cpuAbi = Maybe [CpuAbi]
forall a. Maybe a
Nothing,
      device_runtimeVersions :: Maybe RuntimeVersions
device_runtimeVersions = Maybe RuntimeVersions
forall a. Maybe a
Nothing
    }

-- | The ABIs supported by the device (Android only).
newtype CpuAbi = CpuAbi Text
  deriving ((forall x. CpuAbi -> Rep CpuAbi x)
-> (forall x. Rep CpuAbi x -> CpuAbi) -> Generic CpuAbi
forall x. Rep CpuAbi x -> CpuAbi
forall x. CpuAbi -> Rep CpuAbi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CpuAbi x -> CpuAbi
$cfrom :: forall x. CpuAbi -> Rep CpuAbi x
Generic, Int -> CpuAbi -> ShowS
[CpuAbi] -> ShowS
CpuAbi -> String
(Int -> CpuAbi -> ShowS)
-> (CpuAbi -> String) -> ([CpuAbi] -> ShowS) -> Show CpuAbi
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CpuAbi] -> ShowS
$cshowList :: [CpuAbi] -> ShowS
show :: CpuAbi -> String
$cshow :: CpuAbi -> String
showsPrec :: Int -> CpuAbi -> ShowS
$cshowsPrec :: Int -> CpuAbi -> ShowS
Show)

instance Data.Aeson.ToJSON CpuAbi where
  toJSON :: CpuAbi -> Value
toJSON = Options -> CpuAbi -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: CpuAbi -> Encoding
toEncoding = Options -> CpuAbi -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON CpuAbi where
  parseJSON :: Value -> Parser CpuAbi
parseJSON = Options -> Value -> Parser CpuAbi
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- |
x86_64CpuAbi :: CpuAbi
x86_64CpuAbi :: CpuAbi
x86_64CpuAbi = Text -> CpuAbi
CpuAbi Text
"x86_64"

-- | The versions of the relevant runtimes, languages and/or frameworks for the platform.
data RuntimeVersions = RuntimeVersions
  { -- | The Android API level (Android only).
    RuntimeVersions -> Maybe Text
runtimeVersions_androidApi :: Maybe Text,
    -- | Bottle framework version (Python only).
    RuntimeVersions -> Maybe Text
runtimeVersions_bottle :: Maybe Text,
    -- | Celery task queue version (Python only).
    RuntimeVersions -> Maybe Text
runtimeVersions_celery :: Maybe Text,
    -- | Clang compiler version (iOS/tvOS/macOS only).
    RuntimeVersions -> Maybe Text
runtimeVersions_clangVersion :: Maybe Text,
    -- | Cocos2d-x framework version (Cocos2d-x only).
    RuntimeVersions -> Maybe Text
runtimeVersions_cocos2dx :: Maybe Text,
    -- | Delayed Job framework version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_delayedJob :: Maybe Text,
    -- | Django framework version (Python only).
    RuntimeVersions -> Maybe Text
runtimeVersions_django :: Maybe Text,
    -- | Description of the framework (.NET only).
    RuntimeVersions -> Maybe Text
runtimeVersions_dotnet :: Maybe Text,
    -- | .NET API compatibility level (Unity only).
    RuntimeVersions -> Maybe Text
runtimeVersions_dotnetApiCompatibility :: Maybe Text,
    -- | Version of .NET Common Language Runtime (.NET only).
    RuntimeVersions -> Maybe Text
runtimeVersions_dotnetClr :: Maybe Text,
    -- | .NET scripting runtime version (Unity only).
    RuntimeVersions -> Maybe Text
runtimeVersions_dotnetScriptingRuntime :: Maybe Text,
    -- | EventMachine library version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_eventMachine :: Maybe Text,
    -- | Expo app version (Expo only).
    RuntimeVersions -> Maybe Text
runtimeVersions_expoApp :: Maybe Text,
    -- | Expo SDK version (Expo only).
    RuntimeVersions -> Maybe Text
runtimeVersions_expoSdk :: Maybe Text,
    -- | Flask framework version (Python only).
    RuntimeVersions -> Maybe Text
runtimeVersions_flask :: Maybe Text,
    -- | Gin framework version (Go only).
    RuntimeVersions -> Maybe Text
runtimeVersions_gin :: Maybe Text,
    -- | Go language version (Go only).
    RuntimeVersions -> Maybe Text
runtimeVersions_go :: Maybe Text,
    -- | Java platform implementation type (Java only).
    RuntimeVersions -> Maybe Text
runtimeVersions_javaType :: Maybe Text,
    -- | Java platform implementation type (Java only).
    RuntimeVersions -> Maybe Text
runtimeVersions_javaVersion :: Maybe Text,
    -- | Version of JRuby (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_jruby :: Maybe Text,
    -- | Laravel framework version (PHP only).
    RuntimeVersions -> Maybe Text
runtimeVersions_laravel :: Maybe Text,
    -- | Lumen framework version (PHP only).
    RuntimeVersions -> Maybe Text
runtimeVersions_lumen :: Maybe Text,
    -- | Magento platform version (PHP only).
    RuntimeVersions -> Maybe Text
runtimeVersions_magento :: Maybe Text,
    -- | Mailman framework version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_mailman :: Maybe Text,
    -- | Martini framework version (Go only).
    RuntimeVersions -> Maybe Text
runtimeVersions_martini :: Maybe Text,
    -- | Negroni framework version (Go only).
    RuntimeVersions -> Maybe Text
runtimeVersions_negroni :: Maybe Text,
    -- | Node.js version (Javascript only).
    RuntimeVersions -> Maybe Text
runtimeVersions_node :: Maybe Text,
    -- | Build number of the OS (iOS/tvOS/macOS only).
    RuntimeVersions -> Maybe Text
runtimeVersions_osBuild :: Maybe Text,
    -- | Version of PHP (PHP only).
    RuntimeVersions -> Maybe Text
runtimeVersions_php :: Maybe Text,
    -- | Version of Python (Python only).
    RuntimeVersions -> Maybe Text
runtimeVersions_python :: Maybe Text,
    -- | Que job queue version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_que :: Maybe Text,
    -- | Rack webserver version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_rack :: Maybe Text,
    -- | Ruby on Rails version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_rails :: Maybe Text,
    -- | Rake tool version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_rake :: Maybe Text,
    -- | Version of React Native (React Native/Expo only).
    RuntimeVersions -> Maybe Text
runtimeVersions_reactNative :: Maybe Text,
    -- | Javascript engine type (React Native/Expo only).
    RuntimeVersions -> Maybe Text
runtimeVersions_reactNativeJsEngine :: Maybe Text,
    -- | Resque library version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_resque :: Maybe Text,
    -- | Revel framework version (Go only).
    RuntimeVersions -> Maybe Text
runtimeVersions_revel :: Maybe Text,
    -- | Version of Ruby (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_ruby :: Maybe Text,
    -- | Shoryoken framework version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_shoryoken :: Maybe Text,
    -- | Sidekiq scheduler version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_sidekiq :: Maybe Text,
    -- | Silex framework version (PHP only).
    RuntimeVersions -> Maybe Text
runtimeVersions_silex :: Maybe Text,
    -- | Sinatra DSL version (Ruby only).
    RuntimeVersions -> Maybe Text
runtimeVersions_sinatra :: Maybe Text,
    -- | Spring Boot framework version (Java only).
    RuntimeVersions -> Maybe Text
runtimeVersions_springBoot :: Maybe Text,
    -- | Spring framework version (Java only).
    RuntimeVersions -> Maybe Text
runtimeVersions_springFramework :: Maybe Text,
    -- | Swift language version (iOS/tvOS/macOS only).
    RuntimeVersions -> Maybe Text
runtimeVersions_swift :: Maybe Text,
    -- | Symfony framework version (PHP only).
    RuntimeVersions -> Maybe Text
runtimeVersions_symfony :: Maybe Text,
    -- | Tornado framework version (Python only).
    RuntimeVersions -> Maybe Text
runtimeVersions_tornado :: Maybe Text,
    -- | Version of Unity.
    RuntimeVersions -> Maybe Text
runtimeVersions_unity :: Maybe Text,
    -- | The Unity scripting backend - Mono or IL2CPP (Unity only).
    RuntimeVersions -> Maybe Text
runtimeVersions_unityScriptingBackend :: Maybe Text,
    -- | Wordpress version (PHP only).
    RuntimeVersions -> Maybe Text
runtimeVersions_wordpress :: Maybe Text
  }
  deriving ((forall x. RuntimeVersions -> Rep RuntimeVersions x)
-> (forall x. Rep RuntimeVersions x -> RuntimeVersions)
-> Generic RuntimeVersions
forall x. Rep RuntimeVersions x -> RuntimeVersions
forall x. RuntimeVersions -> Rep RuntimeVersions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RuntimeVersions x -> RuntimeVersions
$cfrom :: forall x. RuntimeVersions -> Rep RuntimeVersions x
Generic, Int -> RuntimeVersions -> ShowS
[RuntimeVersions] -> ShowS
RuntimeVersions -> String
(Int -> RuntimeVersions -> ShowS)
-> (RuntimeVersions -> String)
-> ([RuntimeVersions] -> ShowS)
-> Show RuntimeVersions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeVersions] -> ShowS
$cshowList :: [RuntimeVersions] -> ShowS
show :: RuntimeVersions -> String
$cshow :: RuntimeVersions -> String
showsPrec :: Int -> RuntimeVersions -> ShowS
$cshowsPrec :: Int -> RuntimeVersions -> ShowS
Show)

instance Data.Aeson.ToJSON RuntimeVersions where
  toJSON :: RuntimeVersions -> Value
toJSON = Options -> RuntimeVersions -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: RuntimeVersions -> Encoding
toEncoding = Options -> RuntimeVersions -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON RuntimeVersions where
  parseJSON :: Value -> Parser RuntimeVersions
parseJSON = Options -> Value -> Parser RuntimeVersions
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default runtimeVersions.
defaultRuntimeVersions :: RuntimeVersions
defaultRuntimeVersions :: RuntimeVersions
defaultRuntimeVersions =
  RuntimeVersions :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> RuntimeVersions
RuntimeVersions
    { runtimeVersions_androidApi :: Maybe Text
runtimeVersions_androidApi = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_bottle :: Maybe Text
runtimeVersions_bottle = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_celery :: Maybe Text
runtimeVersions_celery = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_clangVersion :: Maybe Text
runtimeVersions_clangVersion = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_cocos2dx :: Maybe Text
runtimeVersions_cocos2dx = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_delayedJob :: Maybe Text
runtimeVersions_delayedJob = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_django :: Maybe Text
runtimeVersions_django = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_dotnet :: Maybe Text
runtimeVersions_dotnet = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_dotnetApiCompatibility :: Maybe Text
runtimeVersions_dotnetApiCompatibility = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_dotnetClr :: Maybe Text
runtimeVersions_dotnetClr = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_dotnetScriptingRuntime :: Maybe Text
runtimeVersions_dotnetScriptingRuntime = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_eventMachine :: Maybe Text
runtimeVersions_eventMachine = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_expoApp :: Maybe Text
runtimeVersions_expoApp = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_expoSdk :: Maybe Text
runtimeVersions_expoSdk = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_flask :: Maybe Text
runtimeVersions_flask = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_gin :: Maybe Text
runtimeVersions_gin = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_go :: Maybe Text
runtimeVersions_go = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_javaType :: Maybe Text
runtimeVersions_javaType = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_javaVersion :: Maybe Text
runtimeVersions_javaVersion = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_jruby :: Maybe Text
runtimeVersions_jruby = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_laravel :: Maybe Text
runtimeVersions_laravel = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_lumen :: Maybe Text
runtimeVersions_lumen = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_magento :: Maybe Text
runtimeVersions_magento = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_mailman :: Maybe Text
runtimeVersions_mailman = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_martini :: Maybe Text
runtimeVersions_martini = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_negroni :: Maybe Text
runtimeVersions_negroni = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_node :: Maybe Text
runtimeVersions_node = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_osBuild :: Maybe Text
runtimeVersions_osBuild = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_php :: Maybe Text
runtimeVersions_php = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_python :: Maybe Text
runtimeVersions_python = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_que :: Maybe Text
runtimeVersions_que = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_rack :: Maybe Text
runtimeVersions_rack = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_rails :: Maybe Text
runtimeVersions_rails = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_rake :: Maybe Text
runtimeVersions_rake = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_reactNative :: Maybe Text
runtimeVersions_reactNative = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_reactNativeJsEngine :: Maybe Text
runtimeVersions_reactNativeJsEngine = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_resque :: Maybe Text
runtimeVersions_resque = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_revel :: Maybe Text
runtimeVersions_revel = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_ruby :: Maybe Text
runtimeVersions_ruby = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_shoryoken :: Maybe Text
runtimeVersions_shoryoken = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_sidekiq :: Maybe Text
runtimeVersions_sidekiq = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_silex :: Maybe Text
runtimeVersions_silex = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_sinatra :: Maybe Text
runtimeVersions_sinatra = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_springBoot :: Maybe Text
runtimeVersions_springBoot = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_springFramework :: Maybe Text
runtimeVersions_springFramework = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_swift :: Maybe Text
runtimeVersions_swift = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_symfony :: Maybe Text
runtimeVersions_symfony = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_tornado :: Maybe Text
runtimeVersions_tornado = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_unity :: Maybe Text
runtimeVersions_unity = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_unityScriptingBackend :: Maybe Text
runtimeVersions_unityScriptingBackend = Maybe Text
forall a. Maybe a
Nothing,
      runtimeVersions_wordpress :: Maybe Text
runtimeVersions_wordpress = Maybe Text
forall a. Maybe a
Nothing
    }

-- | Details of any session information associated with the event.
-- This can be used alongside the Bugsnag Session Tracking API to associate the event with a session so that a release's crash rate can be determined.
data Session = Session
  { -- | The unique identifier of the session.
    Session -> Text
session_id :: Text,
    -- | The time (in [ISO 8601 format](https://tools.ietf.org/html/rfc3339#section-5.8)) at which the session started.
    Session -> Text
session_startedAt :: Text,
    -- | Details of the number of handled and unhandled events that have occurred so far in this session.
    Session -> SessionEvents
session_events :: SessionEvents
  }
  deriving ((forall x. Session -> Rep Session x)
-> (forall x. Rep Session x -> Session) -> Generic Session
forall x. Rep Session x -> Session
forall x. Session -> Rep Session x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Session x -> Session
$cfrom :: forall x. Session -> Rep Session x
Generic, Int -> Session -> ShowS
[Session] -> ShowS
Session -> String
(Int -> Session -> ShowS)
-> (Session -> String) -> ([Session] -> ShowS) -> Show Session
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Session] -> ShowS
$cshowList :: [Session] -> ShowS
show :: Session -> String
$cshow :: Session -> String
showsPrec :: Int -> Session -> ShowS
$cshowsPrec :: Int -> Session -> ShowS
Show)

instance Data.Aeson.ToJSON Session where
  toJSON :: Session -> Value
toJSON = Options -> Session -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: Session -> Encoding
toEncoding = Options -> Session -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON Session where
  parseJSON :: Value -> Parser Session
parseJSON = Options -> Value -> Parser Session
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default session.
defaultSession :: Session
defaultSession :: Session
defaultSession =
  Session :: Text -> Text -> SessionEvents -> Session
Session
    { session_id :: Text
session_id = Text
"",
      session_startedAt :: Text
session_startedAt = Text
"",
      session_events :: SessionEvents
session_events = SessionEvents
defaultSessionEvents
    }

-- | Details of the number of handled and unhandled events that have occurred so far in this session.
data SessionEvents = SessionEvents
  { -- | Details of the number of handled and unhandled events that have occurred so far in this session.
    SessionEvents -> Int
sessionEvents_handled :: Int,
    -- | The number of unhandled events that have occurred in this session (including this event)
    SessionEvents -> Int
sessionEvents_unhandled :: Int
  }
  deriving ((forall x. SessionEvents -> Rep SessionEvents x)
-> (forall x. Rep SessionEvents x -> SessionEvents)
-> Generic SessionEvents
forall x. Rep SessionEvents x -> SessionEvents
forall x. SessionEvents -> Rep SessionEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SessionEvents x -> SessionEvents
$cfrom :: forall x. SessionEvents -> Rep SessionEvents x
Generic, Int -> SessionEvents -> ShowS
[SessionEvents] -> ShowS
SessionEvents -> String
(Int -> SessionEvents -> ShowS)
-> (SessionEvents -> String)
-> ([SessionEvents] -> ShowS)
-> Show SessionEvents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionEvents] -> ShowS
$cshowList :: [SessionEvents] -> ShowS
show :: SessionEvents -> String
$cshow :: SessionEvents -> String
showsPrec :: Int -> SessionEvents -> ShowS
$cshowsPrec :: Int -> SessionEvents -> ShowS
Show)

instance Data.Aeson.ToJSON SessionEvents where
  toJSON :: SessionEvents -> Value
toJSON = Options -> SessionEvents -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Data.Aeson.genericToJSON Options
aesonOptions

  toEncoding :: SessionEvents -> Encoding
toEncoding = Options -> SessionEvents -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Data.Aeson.genericToEncoding Options
aesonOptions

instance Data.Aeson.FromJSON SessionEvents where
  parseJSON :: Value -> Parser SessionEvents
parseJSON = Options -> Value -> Parser SessionEvents
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Data.Aeson.genericParseJSON Options
aesonOptions

-- | A default sessionEvents.
defaultSessionEvents :: SessionEvents
defaultSessionEvents :: SessionEvents
defaultSessionEvents =
  SessionEvents :: Int -> Int -> SessionEvents
SessionEvents
    { sessionEvents_handled :: Int
sessionEvents_handled = Int
0,
      sessionEvents_unhandled :: Int
sessionEvents_unhandled = Int
0
    }

aesonOptions :: Data.Aeson.Options
aesonOptions :: Options
aesonOptions =
  Options
Data.Aeson.defaultOptions
    { fieldLabelModifier :: ShowS
Data.Aeson.fieldLabelModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_'),
      omitNothingFields :: Bool
Data.Aeson.omitNothingFields = Bool
True
    }