-- | Reporting to Bugsnag.
--
-- This reporter reports failures to Bugsnag. It does nothing for requests that
-- completed without error.
module Reporter.Bugsnag.Internal where

import qualified Control.Exception.Safe as Exception
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List
import qualified Data.Proxy as Proxy
import qualified Data.Text.IO
import qualified Data.Typeable as Typeable
import qualified Dict
import qualified Environment
import qualified GHC.Stack as Stack
import qualified List
import qualified Log.HttpRequest as HttpRequest
import qualified Log.RedisCommands as RedisCommands
import qualified Log.SqlQuery as SqlQuery
import qualified Network.Bugsnag as Bugsnag
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS as HTTP.TLS
import qualified Network.HostName
import qualified Platform
import qualified Platform.AesonHelpers as AesonHelpers
import qualified Platform.ReporterHelpers as Helpers
import qualified Platform.Timer as Timer
import qualified Prelude

-- | This function takes the root span of a completed request and reports it to
-- Bugsnag, if there has been a failure. A request that completed succesfully
-- is not reported.
--
-- If we squint a bit, the rough shape of data that Bugsnag expects of us is:
--
--    event {attributes} [breadcrumbs]
--
-- Meaning: we can use various attributes to describe an event and in addition
-- pass a list of "breadcrumbs", other events that took place before the one the
-- report we're making is about.
--
-- The root span we pass in is a tree structure. It can have child spans, which
-- in turn can have child spans, etc. Each span is marked with whether it
-- succeeded or failed. If one of the children of a span failed, the span itself
-- failed too.
--
-- To turn this tree structure into the data that Bugsnag expects we're going to
-- take the following approach. First we're going to find the 'root cause span'.
-- This is the most recently started span that failed. The data in this span and
-- it's parents is going to make up the main event to Bugsnag. All other spans
-- that completed before the root cause span started we'll turn into
-- breadcrumbs. For some span tree it might look like this:
--
--     ^     failed span, a = 1            -> event { a = 1,
--     t         succeeded span
--     i         failed span, b = 2        ->         b = 2,
--     m             failed span, c = 3    ->         c = 3 }
--     e                 succeeded span    ->       [ breadcrumb1
--     ^         succeeded span            ->       , breadcrumb2 ]
--
-- A span that happened _after_ the root cause event completed we're not
-- reporting.
--
-- Example usage:
--
-- > settings <- Bugsnag.decode
-- > handler <- Bugsnag.handler settings
-- > Bugsnag.report handler "request-id" span
report :: Handler -> Text -> Platform.TracingSpan -> Prelude.IO ()
report :: Handler -> Text -> TracingSpan -> IO ()
report Handler {Manager
http :: Handler -> Manager
http :: Manager
http, Timer
timer :: Handler -> Timer
timer :: Timer
timer, Event
defaultEvent :: Handler -> Event
defaultEvent :: Event
defaultEvent, Secret ApiKey
apiKey' :: Handler -> Secret ApiKey
apiKey' :: Secret ApiKey
apiKey'} Text
requestId TracingSpan
span =
  if TracingSpan -> Bool
failed TracingSpan
span
    then Manager -> Secret ApiKey -> Event -> IO ()
send Manager
http Secret ApiKey
apiKey' (Text -> Timer -> Event -> TracingSpan -> Event
toEvent Text
requestId Timer
timer Event
defaultEvent TracingSpan
span)
    else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()

-- | Contextual information this reporter needs to do its work. You can create
-- one using 'handler'.
data Handler = Handler
  { Handler -> Manager
http :: HTTP.Manager,
    Handler -> Timer
timer :: Timer.Timer,
    Handler -> Event
defaultEvent :: Bugsnag.Event,
    Handler -> Secret ApiKey
apiKey' :: Log.Secret Bugsnag.ApiKey
  }

-- | Create a 'Handler' for a specified set of 'Settings'. Do this once when
-- your application starts and reuse the 'Handler' you get.
handler :: Settings -> Prelude.IO Handler
handler :: Settings -> IO Handler
handler Settings
settings = do
  Manager
http <- IO Manager
HTTP.TLS.getGlobalManager
  Event
defaultEvent <- Settings -> IO Event
mkDefaultEvent Settings
settings
  Timer
timer <- IO Timer
Timer.mkTimer
  Handler -> IO Handler
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
    Handler :: Manager -> Timer -> Event -> Secret ApiKey -> Handler
Handler
      { Manager
http :: Manager
http :: Manager
http,
        Timer
timer :: Timer
timer :: Timer
timer,
        Event
defaultEvent :: Event
defaultEvent :: Event
defaultEvent,
        apiKey' :: Secret ApiKey
apiKey' = Settings -> Secret ApiKey
apiKey Settings
settings
      }

send :: HTTP.Manager -> Log.Secret Bugsnag.ApiKey -> Bugsnag.Event -> Prelude.IO ()
send :: Manager -> Secret ApiKey -> Event -> IO ()
send Manager
manager Secret ApiKey
key Event
event = do
  Either HttpException ()
result <- Manager -> ApiKey -> [Event] -> IO (Either HttpException ())
Bugsnag.sendEvents Manager
manager (Secret ApiKey -> ApiKey
forall a. Secret a -> a
Log.unSecret Secret ApiKey
key) [Event
event]
  case Either HttpException ()
result of
    Prelude.Left HttpException
err -> HttpException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Exception.throwIO HttpException
err
    Prelude.Right ()
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()

toEvent :: Text -> Timer.Timer -> Bugsnag.Event -> Platform.TracingSpan -> Bugsnag.Event
toEvent :: Text -> Timer -> Event -> TracingSpan -> Event
toEvent Text
requestId Timer
timer Event
defaultEvent TracingSpan
span =
  [StackFrame] -> Crumbs -> Timer -> Event -> TracingSpan -> Event
rootCause [] Crumbs
emptyCrumbs Timer
timer Event
rootEvent TracingSpan
span
  where
    rootEvent :: Event
rootEvent =
      Event
defaultEvent
        { event_metaData :: Maybe Object
Bugsnag.event_metaData =
            Maybe Object -> Maybe Object -> Maybe Object
mergeMetaData
              (Event -> Maybe Object
Bugsnag.event_metaData Event
defaultEvent)
              (Object -> Maybe Object
forall a. a -> Maybe a
Just Object
rootMetaData)
        }
    rootMetaData :: Object
rootMetaData =
      [ Text
"response time in ms"
          Text -> Float -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ( TracingSpan -> Word64
Timer.durationInUs TracingSpan
span
                 Word64 -> (Word64 -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Word64 -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                 Float -> (Float -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Float -> Float -> Float
forall number. Num number => number -> number -> number
(*) Float
1e-3 ::
                 Float
             ),
        Text
"megabytes allocated"
          Text -> Float -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ( Int -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (TracingSpan -> Int
Platform.allocated TracingSpan
span)
                 Float -> Float -> Float
/ (Float
1024 Float -> Float -> Float
forall number. Num number => number -> number -> number
* Float
1024) ::
                 Float
             ),
        Text
"request id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
requestId
      ]
        [Pair] -> ([Pair] -> Value) -> Value
forall a b. a -> (a -> b) -> b
|> [Pair] -> Value
Aeson.object
        Value -> (Value -> Object) -> Object
forall a b. a -> (a -> b) -> b
|> Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"request"

-- | Find the most recently started span that failed. This span is closest to
-- the failure and we'll use the data in it and its parents to build the
-- exception we send to Bugsnag. We'll send information about spans that ran
-- before the root cause span started as breadcrumbs.
rootCause ::
  [Bugsnag.StackFrame] ->
  Crumbs ->
  Timer.Timer ->
  Bugsnag.Event ->
  Platform.TracingSpan ->
  Bugsnag.Event
rootCause :: [StackFrame] -> Crumbs -> Timer -> Event -> TracingSpan -> Event
rootCause [StackFrame]
frames Crumbs
breadcrumbs Timer
timer Event
event TracingSpan
span =
  let newFrames :: [StackFrame]
newFrames =
        case TracingSpan -> Maybe (Text, SrcLoc)
Platform.frame TracingSpan
span of
          Maybe (Text, SrcLoc)
Nothing -> [StackFrame]
frames
          Just (Text
name, SrcLoc
src) -> Text -> SrcLoc -> StackFrame
toStackFrame Text
name SrcLoc
src StackFrame -> [StackFrame] -> [StackFrame]
forall a. a -> [a] -> [a]
: [StackFrame]
frames
      newEvent :: Event
newEvent = TracingSpan -> Event -> Event
decorateEventWithTracingSpanData TracingSpan
span Event
event
      childTracingSpans :: [TracingSpan]
childTracingSpans = TracingSpan -> [TracingSpan]
Platform.children TracingSpan
span
   in -- We're not interested in child spans that happened _after_ the root
      -- cause took place. These are not breadcrumbs (leading up to the error)
      -- nor can they have caused the error itself because they happened after.
      -- Since child spans are ordered most-recent first we can keep dropping
      -- child spans until we hit the one where the most recent error happened.
      case (TracingSpan -> Bool) -> [TracingSpan] -> [TracingSpan]
forall a. (a -> Bool) -> [a] -> [a]
Data.List.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (TracingSpan -> Bool) -> TracingSpan -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< TracingSpan -> Bool
failed) [TracingSpan]
childTracingSpans of
        TracingSpan
child : [TracingSpan]
preErrorTracingSpans ->
          [StackFrame] -> Crumbs -> Timer -> Event -> TracingSpan -> Event
rootCause
            [StackFrame]
newFrames
            ( Crumbs
breadcrumbs
                Crumbs -> (Crumbs -> Crumbs) -> Crumbs
forall a b. a -> (a -> b) -> b
|> Crumbs -> Crumbs -> Crumbs
followedBy (Breadcrumb -> Crumbs
addCrumb (Timer -> TracingSpan -> Breadcrumb
startBreadcrumb Timer
timer TracingSpan
span))
                Crumbs -> (Crumbs -> Crumbs) -> Crumbs
forall a b. a -> (a -> b) -> b
|> Crumbs -> Crumbs -> Crumbs
followedBy (Timer -> [TracingSpan] -> Crumbs
addCrumbs Timer
timer [TracingSpan]
preErrorTracingSpans)
            )
            Timer
timer
            Event
newEvent
            TracingSpan
child
        [] ->
          Event
newEvent
            { event_exceptions :: [Exception]
Bugsnag.event_exceptions = [[StackFrame] -> TracingSpan -> Exception
toException [StackFrame]
newFrames TracingSpan
span],
              event_breadcrumbs :: Maybe [Breadcrumb]
Bugsnag.event_breadcrumbs =
                -- This is the innermost span that failed, so all it's children
                -- succeeded. We're going to assume that the error happened
                -- after the last of these child spans, making all child spans
                -- breadcrumbs.
                Crumbs
breadcrumbs
                  Crumbs -> (Crumbs -> Crumbs) -> Crumbs
forall a b. a -> (a -> b) -> b
|> Crumbs -> Crumbs -> Crumbs
followedBy (Timer -> [TracingSpan] -> Crumbs
addCrumbs Timer
timer [TracingSpan]
childTracingSpans)
                  Crumbs -> (Crumbs -> [Breadcrumb]) -> [Breadcrumb]
forall a b. a -> (a -> b) -> b
|> Crumbs -> [Breadcrumb]
crumbsAsList
                  [Breadcrumb] -> ([Breadcrumb] -> [Breadcrumb]) -> [Breadcrumb]
forall a b. a -> (a -> b) -> b
|> [Breadcrumb] -> [Breadcrumb]
forall a. List a -> List a
List.reverse
                  [Breadcrumb]
-> ([Breadcrumb] -> Maybe [Breadcrumb]) -> Maybe [Breadcrumb]
forall a b. a -> (a -> b) -> b
|> [Breadcrumb] -> Maybe [Breadcrumb]
forall a. a -> Maybe a
Just,
              event_unhandled :: Maybe Bool
Bugsnag.event_unhandled = case TracingSpan -> Succeeded
Platform.succeeded TracingSpan
span of
                Succeeded
Platform.Succeeded -> Maybe Bool
forall a. Maybe a
Nothing
                -- `Failed` indicates a span was marked as failed by the application
                -- author. Something went wrong, but we wrote logic to handle it.
                Succeeded
Platform.Failed -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                -- `FailedWith` indicates a Haskell exception was thrown. We don't throw
                -- in our applications, so this indicates a library is doing something
                -- we didn't expect.
                Platform.FailedWith SomeException
_ -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
            }

-- | This function is passed a list of spans and outputs a type representing a
-- flat list of breadcrumbs.
--
-- Each span can contain child spans requiring us to recurse.
--
-- Our Bugsnag library asks for a value of type `[Bugsnag.Breadcrumb]`, so a
-- list. It's very performant to add single items to the front of a list, but
-- appending two lists is costly. So we want to avoid appending in our
-- breadcrumb collection, because if the span tree gets large we'd be doing a
-- lot of it.
--
-- To help us avoid doing appends we create a helper type `Crumbs a`. The only
-- helper function it exposes for adding a breadcrumb is one that cons that
-- breadcrumb to the front of the list, ensuring no appends take place.
addCrumbs :: Timer.Timer -> [Platform.TracingSpan] -> Crumbs
addCrumbs :: Timer -> [TracingSpan] -> Crumbs
addCrumbs Timer
timer [TracingSpan]
spans =
  case [TracingSpan]
spans of
    [] -> Crumbs
emptyCrumbs
    TracingSpan
span : [TracingSpan]
after ->
      Timer -> [TracingSpan] -> Crumbs
addCrumbs Timer
timer [TracingSpan]
after
        Crumbs -> (Crumbs -> Crumbs) -> Crumbs
forall a b. a -> (a -> b) -> b
|> Crumbs -> Crumbs -> Crumbs
followedBy (Timer -> TracingSpan -> Crumbs
addCrumbsForTracingSpan Timer
timer TracingSpan
span)

addCrumbsForTracingSpan :: Timer.Timer -> Platform.TracingSpan -> Crumbs
addCrumbsForTracingSpan :: Timer -> TracingSpan -> Crumbs
addCrumbsForTracingSpan Timer
timer TracingSpan
span =
  case TracingSpan -> [TracingSpan]
Platform.children TracingSpan
span of
    [] ->
      Breadcrumb -> Crumbs
addCrumb (Timer -> TracingSpan -> Breadcrumb
doBreadcrumb Timer
timer TracingSpan
span)
    [TracingSpan]
children ->
      Breadcrumb -> Crumbs
addCrumb (Timer -> TracingSpan -> Breadcrumb
startBreadcrumb Timer
timer TracingSpan
span)
        Crumbs -> (Crumbs -> Crumbs) -> Crumbs
forall a b. a -> (a -> b) -> b
|> Crumbs -> Crumbs -> Crumbs
followedBy (Timer -> [TracingSpan] -> Crumbs
addCrumbs Timer
timer [TracingSpan]
children)
        Crumbs -> (Crumbs -> Crumbs) -> Crumbs
forall a b. a -> (a -> b) -> b
|> Crumbs -> Crumbs -> Crumbs
followedBy (Breadcrumb -> Crumbs
addCrumb (Timer -> TracingSpan -> Breadcrumb
endBreadcrumb Timer
timer TracingSpan
span))

-- | A type representing a list of breadcrumbs. We're not using just a list
-- directly, because then in constructing the full list of breadcrumbs we'd have
-- to do list appends often, which aren't very efficient. Instead we store a
-- function that describes creation of the eventual list of breadcrumbs from an
-- initially empty list.
newtype Crumbs = Crumbs ([Bugsnag.Breadcrumb] -> [Bugsnag.Breadcrumb])

emptyCrumbs :: Crumbs
emptyCrumbs :: Crumbs
emptyCrumbs = ([Breadcrumb] -> [Breadcrumb]) -> Crumbs
Crumbs [Breadcrumb] -> [Breadcrumb]
forall a. a -> a
identity

-- | Combine breadcrumbs, placing one set after the other.
--
--     earlyCrumbs
--       |> followedBy laterCrumbs
followedBy :: Crumbs -> Crumbs -> Crumbs
followedBy :: Crumbs -> Crumbs -> Crumbs
followedBy (Crumbs [Breadcrumb] -> [Breadcrumb]
f) (Crumbs [Breadcrumb] -> [Breadcrumb]
g) = ([Breadcrumb] -> [Breadcrumb]) -> Crumbs
Crumbs ([Breadcrumb] -> [Breadcrumb]
f ([Breadcrumb] -> [Breadcrumb])
-> ([Breadcrumb] -> [Breadcrumb]) -> [Breadcrumb] -> [Breadcrumb]
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< [Breadcrumb] -> [Breadcrumb]
g)

crumbsAsList :: Crumbs -> [Bugsnag.Breadcrumb]
crumbsAsList :: Crumbs -> [Breadcrumb]
crumbsAsList (Crumbs [Breadcrumb] -> [Breadcrumb]
f) = [Breadcrumb] -> [Breadcrumb]
f []

addCrumb :: Bugsnag.Breadcrumb -> Crumbs
addCrumb :: Breadcrumb -> Crumbs
addCrumb Breadcrumb
crumb = ([Breadcrumb] -> [Breadcrumb]) -> Crumbs
Crumbs (Breadcrumb
crumb Breadcrumb -> [Breadcrumb] -> [Breadcrumb]
forall a. a -> [a] -> [a]
:)

endBreadcrumb :: Timer.Timer -> Platform.TracingSpan -> Bugsnag.Breadcrumb
endBreadcrumb :: Timer -> TracingSpan -> Breadcrumb
endBreadcrumb Timer
timer TracingSpan
span =
  Breadcrumb
Bugsnag.defaultBreadcrumb
    { breadcrumb_name :: Text
Bugsnag.breadcrumb_name = Text
"Finished: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ TracingSpan -> Text
Platform.name TracingSpan
span,
      breadcrumb_type :: BreadcrumbType
Bugsnag.breadcrumb_type = BreadcrumbType
Bugsnag.logBreadcrumbType,
      breadcrumb_timestamp :: Text
Bugsnag.breadcrumb_timestamp = Timer -> MonotonicTime -> Text
Timer.toISO8601 Timer
timer (TracingSpan -> MonotonicTime
Platform.finished TracingSpan
span)
    }

startBreadcrumb :: Timer.Timer -> Platform.TracingSpan -> Bugsnag.Breadcrumb
startBreadcrumb :: Timer -> TracingSpan -> Breadcrumb
startBreadcrumb Timer
timer TracingSpan
span =
  (Timer -> TracingSpan -> Breadcrumb
doBreadcrumb Timer
timer TracingSpan
span)
    { breadcrumb_name :: Text
Bugsnag.breadcrumb_name = Text
"Starting: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ TracingSpan -> Text
Platform.name TracingSpan
span
    }

doBreadcrumb :: Timer.Timer -> Platform.TracingSpan -> Bugsnag.Breadcrumb
doBreadcrumb :: Timer -> TracingSpan -> Breadcrumb
doBreadcrumb Timer
timer TracingSpan
span =
  let defaultBreadcrumb :: Breadcrumb
defaultBreadcrumb =
        Breadcrumb
Bugsnag.defaultBreadcrumb
          { breadcrumb_name :: Text
Bugsnag.breadcrumb_name = TracingSpan -> Text
Platform.name TracingSpan
span,
            breadcrumb_type :: BreadcrumbType
Bugsnag.breadcrumb_type = BreadcrumbType
Bugsnag.manualBreadcrumbType,
            breadcrumb_timestamp :: Text
Bugsnag.breadcrumb_timestamp = Timer -> MonotonicTime -> Text
Timer.toISO8601 Timer
timer (TracingSpan -> MonotonicTime
Platform.started TracingSpan
span),
            breadcrumb_metaData :: Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData = Maybe (HashMap Text Text)
stackFrameMetaData Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text) -> Maybe (HashMap Text Text)
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Maybe (HashMap Text Text)
durationMetaData
          }
      stackFrameMetaData :: Maybe (HashMap Text Text)
stackFrameMetaData =
        case TracingSpan -> Maybe (Text, SrcLoc)
Platform.frame TracingSpan
span of
          Maybe (Text, SrcLoc)
Nothing -> Maybe (HashMap Text Text)
forall a. Maybe a
Nothing
          Just (Text
_, SrcLoc
frame) ->
            SrcLoc -> [Char]
Stack.srcLocFile SrcLoc
frame [Char] -> [Char] -> [Char]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [Char]
":" [Char] -> [Char] -> [Char]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> [Char]
forall a. Show a => a -> [Char]
Prelude.show (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
frame)
              [Char] -> ([Char] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> [Char] -> Text
Text.fromList
              Text -> (Text -> HashMap Text Text) -> HashMap Text Text
forall a b. a -> (a -> b) -> b
|> Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"stack frame"
              HashMap Text Text
-> (HashMap Text Text -> Maybe (HashMap Text Text))
-> Maybe (HashMap Text Text)
forall a b. a -> (a -> b) -> b
|> HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just
      durationMetaData :: Maybe (HashMap Text Text)
durationMetaData =
        HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just
          ( Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton
              Text
"duration in milliseconds"
              ( TracingSpan -> Word64
Timer.durationInUs TracingSpan
span
                  Word64 -> (Word64 -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Word64 -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                  Float -> (Float -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Float -> Float -> Float
forall number. Num number => number -> number -> number
(*) Float
1e-3
                  Float -> (Float -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Float -> Text
Text.fromFloat
              )
          )
   in case TracingSpan -> Maybe SomeTracingSpanDetails
Platform.details TracingSpan
span of
        Maybe SomeTracingSpanDetails
Nothing -> Breadcrumb
defaultBreadcrumb
        Just SomeTracingSpanDetails
details -> TracingSpan -> SomeTracingSpanDetails -> Breadcrumb -> Breadcrumb
customizeBreadcrumb TracingSpan
span SomeTracingSpanDetails
details Breadcrumb
defaultBreadcrumb

customizeBreadcrumb :: Platform.TracingSpan -> Platform.SomeTracingSpanDetails -> Bugsnag.Breadcrumb -> Bugsnag.Breadcrumb
customizeBreadcrumb :: TracingSpan -> SomeTracingSpanDetails -> Breadcrumb -> Breadcrumb
customizeBreadcrumb TracingSpan
span SomeTracingSpanDetails
details Breadcrumb
breadcrumb =
  SomeTracingSpanDetails
details
    SomeTracingSpanDetails
-> (SomeTracingSpanDetails -> Maybe Breadcrumb) -> Maybe Breadcrumb
forall a b. a -> (a -> b) -> b
|> [Renderer Breadcrumb] -> SomeTracingSpanDetails -> Maybe Breadcrumb
forall a. [Renderer a] -> SomeTracingSpanDetails -> Maybe a
Platform.renderTracingSpanDetails
      [ (Outgoing -> Breadcrumb) -> Renderer Breadcrumb
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (Breadcrumb -> Outgoing -> Breadcrumb
outgoingHttpRequestAsBreadcrumb Breadcrumb
breadcrumb),
        (Details -> Breadcrumb) -> Renderer Breadcrumb
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (Breadcrumb -> Details -> Breadcrumb
sqlQueryAsBreadcrumb Breadcrumb
breadcrumb),
        (Details -> Breadcrumb) -> Renderer Breadcrumb
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (Breadcrumb -> Details -> Breadcrumb
redisQueryAsBreadcrumb Breadcrumb
breadcrumb),
        (LogContexts -> Breadcrumb) -> Renderer Breadcrumb
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (TracingSpan -> Breadcrumb -> LogContexts -> Breadcrumb
logAsBreadcrumb TracingSpan
span Breadcrumb
breadcrumb),
        (SomeTracingSpanDetails -> Breadcrumb) -> Renderer Breadcrumb
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (Breadcrumb -> SomeTracingSpanDetails -> Breadcrumb
unknownAsBreadcrumb Breadcrumb
breadcrumb)
      ]
    Maybe Breadcrumb -> (Maybe Breadcrumb -> Breadcrumb) -> Breadcrumb
forall a b. a -> (a -> b) -> b
|> Breadcrumb -> Maybe Breadcrumb -> Breadcrumb
forall a. a -> Maybe a -> a
Maybe.withDefault Breadcrumb
breadcrumb

outgoingHttpRequestAsBreadcrumb :: Bugsnag.Breadcrumb -> HttpRequest.Outgoing -> Bugsnag.Breadcrumb
outgoingHttpRequestAsBreadcrumb :: Breadcrumb -> Outgoing -> Breadcrumb
outgoingHttpRequestAsBreadcrumb Breadcrumb
breadcrumb (HttpRequest.Outgoing Details
details) =
  Breadcrumb
breadcrumb
    { breadcrumb_type :: BreadcrumbType
Bugsnag.breadcrumb_type = BreadcrumbType
Bugsnag.requestBreadcrumbType,
      breadcrumb_metaData :: Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData =
        Breadcrumb -> Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData Breadcrumb
breadcrumb Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text) -> Maybe (HashMap Text Text)
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just (Details -> HashMap Text Text
forall a. ToJSON a => a -> HashMap Text Text
Helpers.toHashMap Details
details)
    }

sqlQueryAsBreadcrumb :: Bugsnag.Breadcrumb -> SqlQuery.Details -> Bugsnag.Breadcrumb
sqlQueryAsBreadcrumb :: Breadcrumb -> Details -> Breadcrumb
sqlQueryAsBreadcrumb Breadcrumb
breadcrumb Details
details =
  Breadcrumb
breadcrumb
    { breadcrumb_type :: BreadcrumbType
Bugsnag.breadcrumb_type = BreadcrumbType
Bugsnag.requestBreadcrumbType,
      breadcrumb_metaData :: Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData =
        Breadcrumb -> Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData Breadcrumb
breadcrumb Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text) -> Maybe (HashMap Text Text)
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just (Details -> HashMap Text Text
forall a. ToJSON a => a -> HashMap Text Text
Helpers.toHashMap Details
details)
    }

redisQueryAsBreadcrumb :: Bugsnag.Breadcrumb -> RedisCommands.Details -> Bugsnag.Breadcrumb
redisQueryAsBreadcrumb :: Breadcrumb -> Details -> Breadcrumb
redisQueryAsBreadcrumb Breadcrumb
breadcrumb Details
details =
  Breadcrumb
breadcrumb
    { breadcrumb_type :: BreadcrumbType
Bugsnag.breadcrumb_type = BreadcrumbType
Bugsnag.requestBreadcrumbType,
      breadcrumb_metaData :: Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData =
        Breadcrumb -> Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData Breadcrumb
breadcrumb Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text) -> Maybe (HashMap Text Text)
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just (Details -> HashMap Text Text
forall a. ToJSON a => a -> HashMap Text Text
Helpers.toHashMap Details
details)
    }

logAsBreadcrumb :: Platform.TracingSpan -> Bugsnag.Breadcrumb -> Log.LogContexts -> Bugsnag.Breadcrumb
logAsBreadcrumb :: TracingSpan -> Breadcrumb -> LogContexts -> Breadcrumb
logAsBreadcrumb TracingSpan
span Breadcrumb
breadcrumb LogContexts
details =
  Breadcrumb
breadcrumb
    { breadcrumb_type :: BreadcrumbType
Bugsnag.breadcrumb_type =
        if [TracingSpan] -> Bool
forall a. List a -> Bool
List.isEmpty (TracingSpan -> [TracingSpan]
Platform.children TracingSpan
span)
          then BreadcrumbType
Bugsnag.logBreadcrumbType
          else BreadcrumbType
Bugsnag.processBreadcrumbType,
      breadcrumb_metaData :: Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData =
        Breadcrumb -> Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData Breadcrumb
breadcrumb Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text) -> Maybe (HashMap Text Text)
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just (LogContexts -> HashMap Text Text
forall a. ToJSON a => a -> HashMap Text Text
Helpers.toHashMap LogContexts
details)
    }

unknownAsBreadcrumb :: Bugsnag.Breadcrumb -> Platform.SomeTracingSpanDetails -> Bugsnag.Breadcrumb
unknownAsBreadcrumb :: Breadcrumb -> SomeTracingSpanDetails -> Breadcrumb
unknownAsBreadcrumb Breadcrumb
breadcrumb SomeTracingSpanDetails
details =
  Breadcrumb
breadcrumb
    { breadcrumb_type :: BreadcrumbType
Bugsnag.breadcrumb_type = BreadcrumbType
Bugsnag.manualBreadcrumbType,
      breadcrumb_metaData :: Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData =
        Breadcrumb -> Maybe (HashMap Text Text)
Bugsnag.breadcrumb_metaData Breadcrumb
breadcrumb Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text) -> Maybe (HashMap Text Text)
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just (SomeTracingSpanDetails -> HashMap Text Text
forall a. ToJSON a => a -> HashMap Text Text
Helpers.toHashMap SomeTracingSpanDetails
details)
    }

decorateEventWithTracingSpanData :: Platform.TracingSpan -> Bugsnag.Event -> Bugsnag.Event
decorateEventWithTracingSpanData :: TracingSpan -> Event -> Event
decorateEventWithTracingSpanData TracingSpan
span Event
event =
  TracingSpan -> Maybe SomeTracingSpanDetails
Platform.details TracingSpan
span
    Maybe SomeTracingSpanDetails
-> (Maybe SomeTracingSpanDetails -> Maybe Event) -> Maybe Event
forall a b. a -> (a -> b) -> b
|> (SomeTracingSpanDetails -> Maybe Event)
-> Maybe SomeTracingSpanDetails -> Maybe Event
forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
Maybe.andThen
      ( [Renderer Event] -> SomeTracingSpanDetails -> Maybe Event
forall a. [Renderer a] -> SomeTracingSpanDetails -> Maybe a
Platform.renderTracingSpanDetails
          [ (Incoming -> Event) -> Renderer Event
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (Event -> Incoming -> Event
renderIncomingHttpRequest Event
event),
            (LogContexts -> Event) -> Renderer Event
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (Event -> LogContexts -> Event
renderLog Event
event),
            (SomeTracingSpanDetails -> Event) -> Renderer Event
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (TracingSpan -> Event -> SomeTracingSpanDetails -> Event
renderRemainingTracingSpanDetails TracingSpan
span Event
event)
          ]
      )
    Maybe Event -> (Maybe Event -> Event) -> Event
forall a b. a -> (a -> b) -> b
|> Event -> Maybe Event -> Event
forall a. a -> Maybe a -> a
Maybe.withDefault Event
event

renderRemainingTracingSpanDetails :: Platform.TracingSpan -> Bugsnag.Event -> Platform.SomeTracingSpanDetails -> Bugsnag.Event
renderRemainingTracingSpanDetails :: TracingSpan -> Event -> SomeTracingSpanDetails -> Event
renderRemainingTracingSpanDetails TracingSpan
span Event
event SomeTracingSpanDetails
details =
  Event
event
    { event_metaData :: Maybe Object
Bugsnag.event_metaData =
        SomeTracingSpanDetails -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON SomeTracingSpanDetails
details
          Value -> (Value -> Object) -> Object
forall a b. a -> (a -> b) -> b
|> Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (TracingSpan -> Text
Platform.name TracingSpan
span)
          Object -> (Object -> Maybe Object) -> Maybe Object
forall a b. a -> (a -> b) -> b
|> Object -> Maybe Object
forall a. a -> Maybe a
Just
          Maybe Object -> (Maybe Object -> Maybe Object) -> Maybe Object
forall a b. a -> (a -> b) -> b
|> Maybe Object -> Maybe Object -> Maybe Object
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
(++) (Event -> Maybe Object
Bugsnag.event_metaData Event
event)
    }

renderLog :: Bugsnag.Event -> Log.LogContexts -> Bugsnag.Event
renderLog :: Event -> LogContexts -> Event
renderLog Event
event LogContexts
details =
  Event
event
    { event_metaData :: Maybe Object
Bugsnag.event_metaData =
        LogContexts -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON LogContexts
details
          Value -> (Value -> Object) -> Object
forall a b. a -> (a -> b) -> b
|> Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"custom"
          Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
|> (Value -> Value -> Value) -> Object -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith
            Value -> Value -> Value
mergeJson
            (Event -> Maybe Object
Bugsnag.event_metaData Event
event Maybe Object -> (Maybe Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
|> Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
Maybe.withDefault Object
forall k v. HashMap k v
HashMap.empty)
          Object -> (Object -> Maybe Object) -> Maybe Object
forall a b. a -> (a -> b) -> b
|> Object -> Maybe Object
forall a. a -> Maybe a
Just
    }

mergeJson :: Aeson.Value -> Aeson.Value -> Aeson.Value
mergeJson :: Value -> Value -> Value
mergeJson (Aeson.Object Object
x) (Aeson.Object Object
y) = Object -> Value
Aeson.Object ((Value -> Value -> Value) -> Object -> Object -> Object
AesonHelpers.mergeObjects Value -> Value -> Value
mergeJson Object
x Object
y)
mergeJson Value
_ Value
last = Value
last

mergeMetaData ::
  Maybe (HashMap.HashMap Text Aeson.Value) ->
  Maybe (HashMap.HashMap Text Aeson.Value) ->
  Maybe (HashMap.HashMap Text Aeson.Value)
mergeMetaData :: Maybe Object -> Maybe Object -> Maybe Object
mergeMetaData Maybe Object
Nothing Maybe Object
x = Maybe Object
x
mergeMetaData Maybe Object
x Maybe Object
Nothing = Maybe Object
x
mergeMetaData (Just Object
x) (Just Object
y) = Object -> Maybe Object
forall a. a -> Maybe a
Just ((Value -> Value -> Value) -> Object -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith Value -> Value -> Value
mergeJson Object
x Object
y)

renderIncomingHttpRequest ::
  Bugsnag.Event ->
  HttpRequest.Incoming ->
  Bugsnag.Event
renderIncomingHttpRequest :: Event -> Incoming -> Event
renderIncomingHttpRequest Event
event (HttpRequest.Incoming Details
request) =
  Event
event
    { event_context :: Maybe Text
Bugsnag.event_context = Details -> Maybe Text
HttpRequest.endpoint Details
request,
      event_request :: Maybe Request
Bugsnag.event_request =
        Request -> Maybe Request
forall a. a -> Maybe a
Just
          Request
Bugsnag.defaultRequest
            { request_httpMethod :: Maybe Text
Bugsnag.request_httpMethod = Details -> Maybe Text
HttpRequest.method Details
request,
              request_headers :: Maybe (HashMap Text Text)
Bugsnag.request_headers =
                Details -> Dict Text Text
HttpRequest.headers Details
request
                  Dict Text Text
-> (Dict Text Text -> List (Text, Text)) -> List (Text, Text)
forall a b. a -> (a -> b) -> b
|> Dict Text Text -> List (Text, Text)
forall k v. Dict k v -> List (k, v)
Dict.toList
                  List (Text, Text)
-> (List (Text, Text) -> HashMap Text Text) -> HashMap Text Text
forall a b. a -> (a -> b) -> b
|> List (Text, Text) -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                  HashMap Text Text
-> (HashMap Text Text -> Maybe (HashMap Text Text))
-> Maybe (HashMap Text Text)
forall a b. a -> (a -> b) -> b
|> HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just
            },
      -- Extra request data that Bugsnag doesn't ask for in its API, but which
      -- we can make appear on the 'request' tab anyway by logging it on the
      -- 'request' key of the event metadata.
      event_metaData :: Maybe Object
Bugsnag.event_metaData =
        Maybe Object -> Maybe Object -> Maybe Object
mergeMetaData
          (Event -> Maybe Object
Bugsnag.event_metaData Event
event)
          ( [ Text
"endpoint" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Details -> Maybe Text
HttpRequest.endpoint Details
request,
              Text
"http version" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Details -> Maybe Text
HttpRequest.httpVersion Details
request,
              Text
"response status" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Details -> Maybe Int
HttpRequest.status Details
request,
              Text
"path" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Details -> Maybe Text
HttpRequest.path Details
request,
              Text
"query string" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Details -> Maybe Text
HttpRequest.queryString Details
request
            ]
              [Pair] -> ([Pair] -> Value) -> Value
forall a b. a -> (a -> b) -> b
|> [Pair] -> Value
Aeson.object
              Value -> (Value -> Object) -> Object
forall a b. a -> (a -> b) -> b
|> Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"request"
              Object -> (Object -> Maybe Object) -> Maybe Object
forall a b. a -> (a -> b) -> b
|> Object -> Maybe Object
forall a. a -> Maybe a
Just
          )
    }

failed :: Platform.TracingSpan -> Bool
failed :: TracingSpan -> Bool
failed TracingSpan
span =
  case TracingSpan -> Succeeded
Platform.succeeded TracingSpan
span of
    Succeeded
Platform.Succeeded -> Bool
False
    Succeeded
Platform.Failed -> Bool
True
    Platform.FailedWith SomeException
_ -> Bool
True

toException :: [Bugsnag.StackFrame] -> Platform.TracingSpan -> Bugsnag.Exception
toException :: [StackFrame] -> TracingSpan -> Exception
toException [StackFrame]
frames TracingSpan
span =
  case TracingSpan -> Succeeded
Platform.succeeded TracingSpan
span of
    Succeeded
Platform.Succeeded -> Exception
Bugsnag.defaultException
    Succeeded
Platform.Failed ->
      Exception
Bugsnag.defaultException
        { exception_errorClass :: Text
Bugsnag.exception_errorClass = TracingSpan -> Text
Platform.name TracingSpan
span,
          exception_stacktrace :: [StackFrame]
Bugsnag.exception_stacktrace = [StackFrame]
frames
        }
    Platform.FailedWith (Exception.SomeException e
exception) ->
      Exception
Bugsnag.defaultException
        { exception_errorClass :: Text
Bugsnag.exception_errorClass = e -> Text
forall a. Typeable a => a -> Text
typeName e
exception,
          exception_stacktrace :: [StackFrame]
Bugsnag.exception_stacktrace = [StackFrame]
frames,
          exception_message :: Maybe Text
Bugsnag.exception_message =
            e -> [Char]
forall e. Exception e => e -> [Char]
Exception.displayException e
exception
              [Char] -> ([Char] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> [Char] -> Text
Text.fromList
              Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
|> Text -> Maybe Text
forall a. a -> Maybe a
Just
        }

toStackFrame :: Text -> Stack.SrcLoc -> Bugsnag.StackFrame
toStackFrame :: Text -> SrcLoc -> StackFrame
toStackFrame Text
functionName SrcLoc
frame =
  StackFrame
Bugsnag.defaultStackFrame
    { stackFrame_file :: Text
Bugsnag.stackFrame_file = [Char] -> Text
Text.fromList (SrcLoc -> [Char]
Stack.srcLocFile SrcLoc
frame),
      stackFrame_lineNumber :: Int
Bugsnag.stackFrame_lineNumber = SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
frame,
      stackFrame_columnNumber :: Maybe Int
Bugsnag.stackFrame_columnNumber = Int -> Maybe Int
forall a. a -> Maybe a
Just (SrcLoc -> Int
Stack.srcLocStartCol SrcLoc
frame),
      stackFrame_method :: Text
Bugsnag.stackFrame_method = Text
functionName,
      stackFrame_inProject :: Maybe Bool
Bugsnag.stackFrame_inProject = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    }

typeName :: forall a. Typeable.Typeable a => a -> Text
typeName :: a -> Text
typeName a
_ =
  Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy.Proxy :: Proxy.Proxy a)
    TypeRep -> (TypeRep -> [Char]) -> [Char]
forall a b. a -> (a -> b) -> b
|> TypeRep -> [Char]
forall a. Show a => a -> [Char]
Prelude.show
    [Char] -> ([Char] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> [Char] -> Text
Text.fromList

-- | Configuration settings for this reporter. A value of this type can be read
-- from the environment using the 'decoder' function.
data Settings = Settings
  { -- | The Bugsnag API key to use. This determines which Bugsnag project your
    -- errors will end up in.
    --
    -- [@environment variable@] BUGSNAG_API_KEY
    -- [@default value@] *****
    Settings -> Secret ApiKey
apiKey :: Log.Secret Bugsnag.ApiKey,
    -- | The name of this application. This will be attached to all bugsnag
    -- reports.
    --
    -- [@environment variable@] LOG_ROOT_NAMESPACE
    -- [@default value@] your-application-name-here
    Settings -> Namespace
appName :: Namespace,
    -- | The environment this application is running in. This will be attached
    -- to all bugsnage reports.
    --
    -- [@environment variable@] ENVIRONMENT
    -- [@default value@] development
    Settings -> Environment
appEnvironment :: Environment
  }

-- | Read 'Settings' from environment variables. Default variables will be used
-- in case no environment variable is set for an option.
decoder :: Environment.Decoder Settings
decoder :: Decoder Settings
decoder =
  (Secret ApiKey -> Namespace -> Environment -> Settings)
-> Decoder (Secret ApiKey -> Namespace -> Environment -> Settings)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Secret ApiKey -> Namespace -> Environment -> Settings
Settings
    Decoder (Secret ApiKey -> Namespace -> Environment -> Settings)
-> (Decoder (Secret ApiKey -> Namespace -> Environment -> Settings)
    -> Decoder (Namespace -> Environment -> Settings))
-> Decoder (Namespace -> Environment -> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder (Secret ApiKey)
-> Decoder (Secret ApiKey -> Namespace -> Environment -> Settings)
-> Decoder (Namespace -> Environment -> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder (Secret ApiKey)
apiKeyDecoder
    Decoder (Namespace -> Environment -> Settings)
-> (Decoder (Namespace -> Environment -> Settings)
    -> Decoder (Environment -> Settings))
-> Decoder (Environment -> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder Namespace
-> Decoder (Namespace -> Environment -> Settings)
-> Decoder (Environment -> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder Namespace
namespaceDecoder
    Decoder (Environment -> Settings)
-> (Decoder (Environment -> Settings) -> Decoder Settings)
-> Decoder Settings
forall a b. a -> (a -> b) -> b
|> Decoder Environment
-> Decoder (Environment -> Settings) -> Decoder Settings
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder Environment
environmentDecoder

apiKeyDecoder :: Environment.Decoder (Log.Secret Bugsnag.ApiKey)
apiKeyDecoder :: Decoder (Secret ApiKey)
apiKeyDecoder =
  Variable -> Parser (Secret ApiKey) -> Decoder (Secret ApiKey)
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
"BUGSNAG_API_KEY",
        description :: Text
Environment.description = Text
"The API key of the Bugsnag project we should send items too.",
        defaultValue :: Text
Environment.defaultValue = Text
"*****"
      }
    (Parser Text
Environment.text Parser Text -> (Parser Text -> Parser ApiKey) -> Parser ApiKey
forall a b. a -> (a -> b) -> b
|> (Text -> ApiKey) -> Parser Text -> Parser ApiKey
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> ApiKey
Bugsnag.apiKey Parser ApiKey
-> (Parser ApiKey -> Parser (Secret ApiKey))
-> Parser (Secret ApiKey)
forall a b. a -> (a -> b) -> b
|> Parser ApiKey -> Parser (Secret ApiKey)
forall a. Parser a -> Parser (Secret a)
Environment.secret)

newtype Namespace = Namespace {Namespace -> Text
unNamespace :: Text}

namespaceDecoder :: Environment.Decoder Namespace
namespaceDecoder :: Decoder Namespace
namespaceDecoder =
  Variable -> Parser Namespace -> Decoder Namespace
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
"LOG_ROOT_NAMESPACE",
        description :: Text
Environment.description = Text
"Root of the log namespace. This should be the name of the application.",
        defaultValue :: Text
Environment.defaultValue = Text
"your-application-name-here"
      }
    ((Text -> Namespace) -> Parser Text -> Parser Namespace
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> Namespace
Namespace Parser Text
Environment.text)

newtype Environment = Environment {Environment -> Text
unEnvironment :: Text}

environmentDecoder :: Environment.Decoder Environment
environmentDecoder :: Decoder Environment
environmentDecoder =
  Variable -> Parser Environment -> Decoder Environment
forall a. Variable -> Parser a -> Decoder a
Environment.variable
    Variable :: Text -> Text -> Text -> Variable
Environment.Variable
      { name :: Text
Environment.name = Text
"ENVIRONMENT",
        description :: Text
Environment.description = Text
"Environment to display in logs.",
        defaultValue :: Text
Environment.defaultValue = Text
"development"
      }
    ((Text -> Environment) -> Parser Text -> Parser Environment
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> Environment
Environment Parser Text
Environment.text)

mkDefaultEvent :: Settings -> Prelude.IO Bugsnag.Event
mkDefaultEvent :: Settings -> IO Event
mkDefaultEvent Settings
settings = do
  Revision
revision <- IO Revision
getRevision
  [Char]
hostname <- IO [Char]
Network.HostName.getHostName
  let appId :: Text
appId = Namespace -> Text
unNamespace (Settings -> Namespace
appName Settings
settings)
  let app :: App
app =
        App
Bugsnag.defaultApp
          { app_id :: Maybe Text
Bugsnag.app_id = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
appId,
            -- Same format as what bugsnag-build-notify uses for appVersion
            app_version :: Maybe Text
Bugsnag.app_version = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
appId Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"-" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Revision -> Text
unRevision Revision
revision),
            app_releaseStage :: Maybe Text
Bugsnag.app_releaseStage = Text -> Maybe Text
forall a. a -> Maybe a
Just (Environment -> Text
unEnvironment (Settings -> Environment
appEnvironment Settings
settings)),
            app_type :: Maybe Text
Bugsnag.app_type = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"haskell"
          }
  let device :: Device
device =
        Device
Bugsnag.defaultDevice
          { device_hostname :: Maybe Text
Bugsnag.device_hostname = Text -> Maybe Text
forall a. a -> Maybe a
Just ([Char] -> Text
Text.fromList [Char]
hostname)
          }
  Event -> IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
    Event
Bugsnag.defaultEvent
      { event_app :: Maybe App
Bugsnag.event_app = App -> Maybe App
forall a. a -> Maybe a
Just App
app,
        event_device :: Maybe Device
Bugsnag.event_device = Device -> Maybe Device
forall a. a -> Maybe a
Just Device
device
      }

newtype Revision = Revision {Revision -> Text
unRevision :: Text}

getRevision :: Prelude.IO Revision
getRevision :: IO Revision
getRevision = do
  Either SomeException Text
eitherRevision <- IO Text -> IO (Either SomeException Text)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
Exception.tryAny (IO Text -> IO (Either SomeException Text))
-> IO Text -> IO (Either SomeException Text)
forall a b. (a -> b) -> a -> b
<| [Char] -> IO Text
Data.Text.IO.readFile [Char]
"revision"
  case Either SomeException Text
eitherRevision of
    Prelude.Left SomeException
_err -> Revision -> IO Revision
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text -> Revision
Revision Text
"no revision file found")
    Prelude.Right Text
version -> Revision -> IO Revision
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text -> Revision
Revision Text
version)