nri-observability (empty) → 0.1.0.0

raw patch · 20 files changed

+2260/−0 lines, 20 filesdep +aesondep +aeson-prettydep +async

Dependencies added: aeson, aeson-pretty, async, base, bugsnag-hs, bytestring, directory, hostname, http-client, http-client-tls, nri-env-parser, nri-prelude, random, safe-exceptions, stm, text, time, unordered-containers

Files

• CHANGELOG.md +3/−0
• LICENSE +29/−0
• README.md +12/−0
• nri-observability.cabal +114/−0
• src/Log/HttpRequest.hs +77/−0
• src/Log/RedisCommands.hs +50/−0
• src/Log/SqlQuery.hs +70/−0
• src/Platform/ReporterHelpers.hs +61/−0
• src/Platform/Timer.hs +124/−0
• src/Reporter/Bugsnag.hs +18/−0
• src/Reporter/Bugsnag/Internal.hs +567/−0
• src/Reporter/Dev.hs +19/−0
• src/Reporter/Dev/Internal.hs +114/−0
• src/Reporter/File.hs +26/−0
• src/Reporter/File/Internal.hs +222/−0
• tests/Main.hs +21/−0
• tests/Spec/Platform/Timer.hs +27/−0
• tests/Spec/Reporter/Bugsnag.hs +444/−0
• tests/Spec/Reporter/Dev.hs +76/−0
• tests/Spec/Reporter/File.hs +186/−0

@@ -0,0 +1,3 @@+# 0.1.0.0++- Initial release.

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2021, NoRedInk+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,12 @@+# nri-observability++A library for reporting observability data collected in [nri-prelude][]-backed Haskell applications to various backends.++This library exposes two categories of modules:++- `Reporter` modules for sending data to various backends.+- `Log` modules defining `Details` types for common kinds of tracing spans.++Both can be mixed and matched with `Reporter` and `Details` types defined elsewhere.++[nri-prelude]: https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-prelude

@@ -0,0 +1,114 @@+cabal-version: 1.18++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           nri-observability+version:        0.1.0.0+synopsis:       Report log spans collected by nri-prelude.+description:    Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/observability>.+category:       Web+homepage:       https://github.com/NoRedInk/haskell-libraries#readme+bug-reports:    https://github.com/NoRedInk/haskell-libraries/issues+author:         NoRedInk+maintainer:     haskell-open-source@noredink.com+copyright:      2021 NoRedInk Corp.+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-doc-files:+    README.md+    LICENSE+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/NoRedInk/haskell-libraries+  subdir: observability++library+  exposed-modules:+      Log.HttpRequest+      Log.RedisCommands+      Log.SqlQuery+      Reporter.Bugsnag+      Reporter.Dev+      Reporter.File+  other-modules:+      Platform.ReporterHelpers+      Platform.Timer+      Reporter.Bugsnag.Internal+      Reporter.Dev.Internal+      Reporter.File.Internal+      Paths_nri_observability+  hs-source-dirs:+      src+  default-extensions: DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures ScopedTypeVariables Strict TypeOperators+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -fplugin=NriPrelude.Plugin+  build-depends:+      aeson >=1.4.6.0 && <1.6+    , aeson-pretty >=0.8.0 && <0.9+    , async >=2.2.2 && <2.3+    , base >=4.12.0.0 && <4.15+    , bugsnag-hs >=0.1.0.0 && <0.3+    , bytestring >=0.10.8.2 && <0.12+    , directory >=1.3.3.0 && <1.4+    , hostname >=1.0 && <1.1+    , http-client >=0.6.0 && <0.8+    , http-client-tls >=0.3.0 && <0.4+    , nri-env-parser >=0.1.0.0 && <0.2+    , nri-prelude >=0.1.0.0 && <0.6+    , random >=1.1 && <1.3+    , safe-exceptions >=0.1.7.0 && <1.3+    , stm >=2.4 && <2.6+    , text >=1.2.3.1 && <1.3+    , time >=1.8.0.2 && <1.12+    , unordered-containers >=0.2.0.0 && <0.3+  default-language: Haskell2010++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Spec.Platform.Timer+      Spec.Reporter.Bugsnag+      Spec.Reporter.Dev+      Spec.Reporter.File+      Log.HttpRequest+      Log.RedisCommands+      Log.SqlQuery+      Platform.ReporterHelpers+      Platform.Timer+      Reporter.Bugsnag+      Reporter.Bugsnag.Internal+      Reporter.Dev+      Reporter.Dev.Internal+      Reporter.File+      Reporter.File.Internal+      Paths_nri_observability+  hs-source-dirs:+      tests+      src+  default-extensions: DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures ScopedTypeVariables Strict TypeOperators ExtendedDefaultRules+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -fplugin=NriPrelude.Plugin -threaded -rtsopts "-with-rtsopts=-N -T" -fno-warn-type-defaults+  build-depends:+      aeson >=1.4.6.0 && <1.6+    , aeson-pretty >=0.8.0 && <0.9+    , async >=2.2.2 && <2.3+    , base >=4.12.0.0 && <4.15+    , bugsnag-hs >=0.1.0.0 && <0.3+    , bytestring >=0.10.8.2 && <0.12+    , directory >=1.3.3.0 && <1.4+    , hostname >=1.0 && <1.1+    , http-client >=0.6.0 && <0.8+    , http-client-tls >=0.3.0 && <0.4+    , nri-env-parser >=0.1.0.0 && <0.2+    , nri-prelude >=0.1.0.0 && <0.6+    , random >=1.1 && <1.3+    , safe-exceptions >=0.1.7.0 && <1.3+    , stm >=2.4 && <2.6+    , text >=1.2.3.1 && <1.3+    , time >=1.8.0.2 && <1.12+    , unordered-containers >=0.2.0.0 && <0.3+  default-language: Haskell2010

@@ -0,0 +1,77 @@+-- | A module for creating great logs in code that send or receive HTTP+-- requests.+module Log.HttpRequest+  ( Details,+    Incoming (Incoming),+    Outgoing (Outgoing),+    emptyDetails,+    method,+    host,+    path,+    queryString,+    headers,+    httpVersion,+    endpoint,+    status,+  )+where++import qualified Data.Aeson as Aeson+import qualified Dict++-- | A type describing an http request.+--+-- > emptyDetails+-- >   { method = Just "GET"+-- >   , host = Just "https://noredink.com"+-- >   }+data Details = Details+  { -- | The method of the http request.+    method :: Maybe Text,+    -- | The host the http request is made to.+    host :: Maybe Text,+    -- | The path portion of the request URI.+    path :: Maybe Text,+    -- | The query string portion of the request URI.+    queryString :: Maybe Text,+    -- | The headers on the request. Do not pass headers with sensitive+    -- information in there, filter them out first!+    headers :: Dict.Dict Text Text,+    -- | The version of the http protocol used.+    httpVersion :: Maybe Text,+    -- | The endpoint called. This is like the path, but with the dynamic parts+    -- of the path replaced with arguments.+    --+    -- For example:+    -- > path     /teeth/upperleft/12+    -- > endpoint /teeth/:quadrant/:number+    endpoint :: Maybe Text,+    -- | The response status of the request.+    status :: Maybe Int+  }+  deriving (Generic)++-- | An empty details value to be modified by you.+emptyDetails :: Details+emptyDetails = Details Nothing Nothing Nothing Nothing Dict.empty Nothing Nothing Nothing++instance Aeson.ToJSON Details where+  toJSON = Aeson.genericToJSON infoEncodingOptions+  toEncoding = Aeson.genericToEncoding infoEncodingOptions++infoEncodingOptions :: Aeson.Options+infoEncodingOptions =+  Aeson.defaultOptions+    { Aeson.fieldLabelModifier = Aeson.camelTo2 ' ',+      Aeson.omitNothingFields = True+    }++newtype Incoming = Incoming Details+  deriving (Aeson.ToJSON)++instance Platform.TracingSpanDetails Incoming++newtype Outgoing = Outgoing Details+  deriving (Aeson.ToJSON)++instance Platform.TracingSpanDetails Outgoing

@@ -0,0 +1,50 @@+-- | A module for creating great logs in code that sends commands to Redis.+module Log.RedisCommands+  ( Details,+    emptyDetails,+    commands,+    host,+    port,+  )+where++import qualified Data.Aeson as Aeson++-- | A type describing redis commands.+--+-- > emptyDetails+-- >   { commands = [ "GET weather" ]+-- >   , host = Just "my-redis-host"+-- >   }+data Details = Details+  { -- | The commands that were sent to redis. Because Redis support for+    -- pipelining and transactions it's possible for one logical operation from+    -- the application perspective to contain multiple commands.+    --+    -- These commands are expected not to contain any sensitive information.+    -- Make sure sensitive values are mocked out, for example by replacing them+    -- with *****.+    commands :: List Text,+    -- | The host the redis commands are sent too.+    host :: Maybe Text,+    -- | The port redis is running on.+    port :: Maybe Int+  }+  deriving (Generic)++-- | An empty details value to be modified by you.+emptyDetails :: Details+emptyDetails = Details [] Nothing Nothing++instance Aeson.ToJSON Details where+  toJSON = Aeson.genericToJSON infoEncodingOptions+  toEncoding = Aeson.genericToEncoding infoEncodingOptions++infoEncodingOptions :: Aeson.Options+infoEncodingOptions =+  Aeson.defaultOptions+    { Aeson.fieldLabelModifier = Aeson.camelTo2 ' ',+      Aeson.omitNothingFields = True+    }++instance Platform.TracingSpanDetails Details

@@ -0,0 +1,70 @@+-- | A module for creating great logs in code that makes SQL queries.+module Log.SqlQuery+  ( Details,+    emptyDetails,+    query,+    queryTemplate,+    sqlOperation,+    queriedRelation,+    databaseType,+    host,+    port,+    database,+    rowsReturned,+    mysql,+    postgresql,+  )+where++import qualified Data.Aeson as Aeson++-- | A type describing an SQL query.+--+-- > emptyDetails+-- >   { query = Just (Log.mkSecret "SELECT cuddles FROM puppies")+-- >   , database = Just postgresql+-- >   }+data Details = Details+  { -- | The full query we're executing.+    query :: Maybe (Log.Secret Text),+    -- | The query we're executing with values mocked out.+    queryTemplate :: Maybe Text,+    -- | The SQL operation we're performing (SELECT / INSERT / DELETE / ...).+    sqlOperation :: Maybe Text,+    -- | The primary relation of the query.+    queriedRelation :: Maybe Text,+    -- | The type of database.+    databaseType :: Maybe Text,+    -- | Database host the connection is made to.+    host :: Maybe Text,+    -- | Port the database is running on.+    port :: Maybe Int,+    -- | The name of the database that is being queried.+    database :: Maybe Text,+    -- | The amount of rows this query returned.+    rowsReturned :: Maybe Int+  }+  deriving (Generic)++-- | An empty details value to be modified by you.+emptyDetails :: Details+emptyDetails = Details Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++instance Aeson.ToJSON Details where+  toJSON = Aeson.genericToJSON options+  toEncoding = Aeson.genericToEncoding options++options :: Aeson.Options+options =+  Aeson.defaultOptions+    { Aeson.fieldLabelModifier = Aeson.camelTo2 ' ',+      Aeson.omitNothingFields = True+    }++instance Platform.TracingSpanDetails Details++mysql :: Text+mysql = "MySQL"++postgresql :: Text+postgresql = "PostgreSQL"

@@ -0,0 +1,61 @@+module Platform.ReporterHelpers (toHashMap, srcString) where++import qualified Data.Aeson as Aeson+import qualified Data.Foldable as Foldable+import qualified Data.HashMap.Strict as HashMap+import qualified GHC.Stack as Stack+import qualified List+import qualified Text+import qualified Prelude++-- | Our span details are arbitrary JSON structures, but some of our reporters+-- require metadata as a flast list of key,value pairs.+--+-- Given a type that has the following JSON representation:+--+--     {+--       "treasure": {+--         "coords: { "x": 12, "y" 14 },+--         "worth": "Tons!"+--       }+--     }+--+-- This function will create a flat list of key,value pairs like this:+--+--     HashMap.fromList+--       [ ("treasure.coords.x", "12"   )+--       , ("treasure.coords.y", "14"   )+--       , ("treasure.worth"   , "Tons!")+--       ]+toHashMap :: Aeson.ToJSON a => a -> HashMap.HashMap Text Text+toHashMap x =+  case Aeson.toJSON x of+    Aeson.Object dict ->+      HashMap.foldlWithKey'+        (\acc key value -> acc ++ jsonAsText key value)+        HashMap.empty+        dict+    val -> jsonAsText "value" val++jsonAsText :: Text -> Aeson.Value -> HashMap.HashMap Text Text+jsonAsText key val =+  case val of+    Aeson.Object dict ->+      HashMap.foldlWithKey'+        (\acc key2 value -> acc ++ jsonAsText (key ++ "." ++ key2) value)+        HashMap.empty+        dict+    Aeson.Array vals ->+      Foldable.toList vals+        |> List.indexedMap (\i elem -> jsonAsText (key ++ "." ++ Text.fromInt i) elem)+        |> HashMap.unions+    Aeson.String str -> HashMap.singleton key str+    Aeson.Number n -> HashMap.singleton key (Text.fromList (Prelude.show n))+    Aeson.Bool bool -> HashMap.singleton key (Text.fromList (Prelude.show bool))+    Aeson.Null -> HashMap.empty++srcString :: Stack.SrcLoc -> Text+srcString frame =+  Text.fromList (Stack.srcLocFile frame)+    ++ ":"+    ++ Text.fromInt (Prelude.fromIntegral (Stack.srcLocStartLine frame))

@@ -0,0 +1,124 @@+{-# OPTIONS_GHC -fno-cse #-}++-- | Helper functions for converting the timestamp format used in our `Span`+-- data to the time formats used by the various platforms we report to.+module Platform.Timer+  ( Timer (Timer),+    mkTimer,+    toUTC,+    toLocal,+    toPosix,+    toPosixMicroseconds,+    toISO8601,+    difference,+    durationInUs,+  )+where++import qualified Control.Concurrent.MVar as MVar+import qualified Data.Time.Clock as Clock+import qualified Data.Time.Clock.POSIX as Clock.POSIX+import qualified Data.Time.Format as Format+import qualified Data.Time.LocalTime as LocalTime+import qualified Data.Word as Word+import qualified GHC.Clock+import qualified Platform+import qualified System.IO.Unsafe+import qualified Prelude++-- | Our spans' timestamps are produced by the `GHC.Clock` module and consist of+-- the amount of time passed since some arbitrary (but constant) moment in the+-- past. This is the faster and more accurate way to measure precisely what the+-- running time of spans is. This type helpers convert these times into regular+-- dates.+data Timer = Timer+  { -- | The POSIX time in microseconds that corresponds with t=0 according+    -- to `GHC.Clock`. We can use this to calculate other `GHC.Clock`+    -- values.+    tzero :: Word.Word64,+    -- | The timezone of the machine this code is running on. Useful for+    -- printing local times in development reporters.+    timezone :: LocalTime.TimeZone+  }++-- | Create a timer, then cache it. When asked again return the previously+-- created timer.+--+-- Passing separate timers to multiple reporters could result in those reporters+-- disagreeing very subtly on the exact time when events happen. Having a single+-- timer prevents this from happening.+mkTimer :: Prelude.IO Timer+mkTimer =+  MVar.modifyMVar+    timerVar+    ( \maybeTimer ->+        case maybeTimer of+          Just timer -> Prelude.pure (Just timer, timer)+          Nothing -> do+            -- 'Sync our clocks', to find our how monotonic time and actual time relate.+            nowTime <- Clock.POSIX.getPOSIXTime+            nowClock <- GHC.Clock.getMonotonicTimeNSec+            timezone <- LocalTime.getCurrentTimeZone+            let tzero = Prelude.floor (1e6 * nowTime) - (nowClock `Prelude.div` 1000)+            let timer = Timer {tzero, timezone}+            Prelude.pure (Just timer, timer)+    )++{-# NOINLINE timerVar #-}+timerVar :: MVar.MVar (Maybe Timer)+timerVar = System.IO.Unsafe.unsafePerformIO (MVar.newMVar Nothing)++toUTC :: Timer -> Platform.MonotonicTime -> Clock.UTCTime+toUTC timer clock =+  toPosix timer clock+    |> Clock.POSIX.posixSecondsToUTCTime++toLocal :: Timer -> Platform.MonotonicTime -> LocalTime.LocalTime+toLocal timer clock =+  toUTC timer clock+    |> LocalTime.utcToLocalTime (timezone timer)++toPosixMicroseconds :: Timer -> Platform.MonotonicTime -> Word.Word64+toPosixMicroseconds timer clock = tzero timer + Platform.inMicroseconds clock++toPosix :: Timer -> Platform.MonotonicTime -> Clock.POSIX.POSIXTime+toPosix timer clock =+  toPosixMicroseconds timer clock+    |> Prelude.fromIntegral+    |> (*) 1e-6++toISO8601 :: Timer -> Platform.MonotonicTime -> Text+toISO8601 timer clock =+  toUTC timer clock+    |> Format.formatTime Format.defaultTimeLocale "%FT%T%QZ"+    |> Text.fromList++-- | We have to be careful when calculating the difference between two times.+-- Because they are unsigned (don't allow negative numbers), subtracting times+-- in the wrong order is going to result in very large numbers:+--+--     ghci> import GHC.Word+--     ghci> 5 - 2 :: Word64+--     3+--     ghci> 2 - 5 :: Word64+--     18446744073709551613+--+-- The span data we get from Platform should ensure end times always come+-- before start times. If they're not though one of these extremely long span+-- durations can have a major effect on request duration statistics.+--+-- This function performs some defensive programming to prevent flukes from+-- doing major damage.+difference :: Platform.MonotonicTime -> Platform.MonotonicTime -> Platform.MonotonicTime+difference start end =+  if end > start+    then end - start+    else 0++-- | Get the time covered by a duration in microseconds.+durationInUs :: Platform.TracingSpan -> Word.Word64+durationInUs span =+  difference+    (Platform.started span)+    (Platform.finished span)+    |> Platform.inMicroseconds

@@ -0,0 +1,18 @@+-- | This reporter sends tracing information for failing requests to Bugsnag,+-- a platform for monitoring applications. Learn more about Bugsnag on their+-- website:+--+-- <https://www.bugsnag.com/>+module Reporter.Bugsnag+  ( Internal.report,+    Internal.Handler,+    Internal.handler,+    Internal.Settings,+    Internal.decoder,+    Internal.apiKey,+    Internal.appName,+    Internal.appEnvironment,+  )+where++import qualified Reporter.Bugsnag.Internal as Internal

@@ -0,0 +1,567 @@+-- | 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.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 {http, timer, defaultEvent, apiKey'} requestId span =+  if failed span+    then send http apiKey' (toEvent requestId timer defaultEvent span)+    else Prelude.pure ()++-- | Contextual information this reporter needs to do its work. You can create+-- one using 'handler'.+data Handler = Handler+  { http :: HTTP.Manager,+    timer :: Timer.Timer,+    defaultEvent :: Bugsnag.Event,+    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 = do+  http <- HTTP.TLS.getGlobalManager+  defaultEvent <- mkDefaultEvent settings+  timer <- Timer.mkTimer+  Prelude.pure+    Handler+      { http,+        timer,+        defaultEvent,+        apiKey' = apiKey settings+      }++send :: HTTP.Manager -> Log.Secret Bugsnag.ApiKey -> Bugsnag.Event -> Prelude.IO ()+send manager key event = do+  result <- Bugsnag.sendEvents manager (Log.unSecret key) [event]+  case result of+    Prelude.Left err -> Exception.throwIO err+    Prelude.Right _ -> Prelude.pure ()++toEvent :: Text -> Timer.Timer -> Bugsnag.Event -> Platform.TracingSpan -> Bugsnag.Event+toEvent requestId timer defaultEvent span =+  rootCause [] emptyCrumbs timer rootEvent span+  where+    rootEvent =+      defaultEvent+        { Bugsnag.event_metaData =+            mergeMetaData+              (Bugsnag.event_metaData defaultEvent)+              (Just rootMetaData)+        }+    rootMetaData =+      [ "response time in ms"+          .= ( Timer.durationInUs span+                 |> Prelude.fromIntegral+                 |> (*) 1e-3 ::+                 Float+             ),+        "megabytes allocated"+          .= ( Prelude.fromIntegral (Platform.allocated span)+                 / (1024 * 1024) ::+                 Float+             ),+        "request id" .= requestId+      ]+        |> Aeson.object+        |> HashMap.singleton "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 frames breadcrumbs timer event span =+  let newFrames =+        case Platform.frame span of+          Nothing -> frames+          Just (name, src) -> toStackFrame name src : frames+      newEvent = decorateEventWithTracingSpanData span event+      childTracingSpans = Platform.children 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 Data.List.dropWhile (not << failed) childTracingSpans of+        child : preErrorTracingSpans ->+          rootCause+            newFrames+            ( breadcrumbs+                |> followedBy (addCrumb (startBreadcrumb timer span))+                |> followedBy (addCrumbs timer preErrorTracingSpans)+            )+            timer+            newEvent+            child+        [] ->+          newEvent+            { Bugsnag.event_exceptions = [toException newFrames span],+              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.+                breadcrumbs+                  |> followedBy (addCrumbs timer childTracingSpans)+                  |> crumbsAsList+                  |> List.reverse+                  |> Just,+              Bugsnag.event_unhandled = case Platform.succeeded span of+                Platform.Succeeded -> Nothing+                -- `Failed` indicates a span was marked as failed by the application+                -- author. Something went wrong, but we wrote logic to handle it.+                Platform.Failed -> Just 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 _ -> Just 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 spans =+  case spans of+    [] -> emptyCrumbs+    span : after ->+      addCrumbs timer after+        |> followedBy (addCrumbsForTracingSpan timer span)++addCrumbsForTracingSpan :: Timer.Timer -> Platform.TracingSpan -> Crumbs+addCrumbsForTracingSpan timer span =+  case Platform.children span of+    [] ->+      addCrumb (doBreadcrumb timer span)+    children ->+      addCrumb (startBreadcrumb timer span)+        |> followedBy (addCrumbs timer children)+        |> followedBy (addCrumb (endBreadcrumb timer 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 identity++-- | Combine breadcrumbs, placing one set after the other.+--+--     earlyCrumbs+--       |> followedBy laterCrumbs+followedBy :: Crumbs -> Crumbs -> Crumbs+followedBy (Crumbs f) (Crumbs g) = Crumbs (f << g)++crumbsAsList :: Crumbs -> [Bugsnag.Breadcrumb]+crumbsAsList (Crumbs f) = f []++addCrumb :: Bugsnag.Breadcrumb -> Crumbs+addCrumb crumb = Crumbs (crumb :)++endBreadcrumb :: Timer.Timer -> Platform.TracingSpan -> Bugsnag.Breadcrumb+endBreadcrumb timer span =+  Bugsnag.defaultBreadcrumb+    { Bugsnag.breadcrumb_name = "Finished: " ++ Platform.name span,+      Bugsnag.breadcrumb_type = Bugsnag.logBreadcrumbType,+      Bugsnag.breadcrumb_timestamp = Timer.toISO8601 timer (Platform.finished span)+    }++startBreadcrumb :: Timer.Timer -> Platform.TracingSpan -> Bugsnag.Breadcrumb+startBreadcrumb timer span =+  (doBreadcrumb timer span)+    { Bugsnag.breadcrumb_name = "Starting: " ++ Platform.name span+    }++doBreadcrumb :: Timer.Timer -> Platform.TracingSpan -> Bugsnag.Breadcrumb+doBreadcrumb timer span =+  let defaultBreadcrumb =+        Bugsnag.defaultBreadcrumb+          { Bugsnag.breadcrumb_name = Platform.name span,+            Bugsnag.breadcrumb_type = Bugsnag.manualBreadcrumbType,+            Bugsnag.breadcrumb_timestamp = Timer.toISO8601 timer (Platform.started span),+            Bugsnag.breadcrumb_metaData = stackFrameMetaData ++ durationMetaData+          }+      stackFrameMetaData =+        case Platform.frame span of+          Nothing -> Nothing+          Just (_, frame) ->+            Stack.srcLocFile frame ++ ":" ++ Prelude.show (Stack.srcLocStartLine frame)+              |> Text.fromList+              |> HashMap.singleton "stack frame"+              |> Just+      durationMetaData =+        Just+          ( HashMap.singleton+              "duration in milliseconds"+              ( Timer.durationInUs span+                  |> Prelude.fromIntegral+                  |> (*) 1e-3+                  |> Text.fromFloat+              )+          )+   in case Platform.details span of+        Nothing -> defaultBreadcrumb+        Just details -> customizeBreadcrumb span details defaultBreadcrumb++customizeBreadcrumb :: Platform.TracingSpan -> Platform.SomeTracingSpanDetails -> Bugsnag.Breadcrumb -> Bugsnag.Breadcrumb+customizeBreadcrumb span details breadcrumb =+  details+    |> Platform.renderTracingSpanDetails+      [ Platform.Renderer (outgoingHttpRequestAsBreadcrumb breadcrumb),+        Platform.Renderer (sqlQueryAsBreadcrumb breadcrumb),+        Platform.Renderer (redisQueryAsBreadcrumb breadcrumb),+        Platform.Renderer (logAsBreadcrumb span breadcrumb),+        Platform.Renderer (unknownAsBreadcrumb breadcrumb)+      ]+    |> Maybe.withDefault breadcrumb++outgoingHttpRequestAsBreadcrumb :: Bugsnag.Breadcrumb -> HttpRequest.Outgoing -> Bugsnag.Breadcrumb+outgoingHttpRequestAsBreadcrumb breadcrumb (HttpRequest.Outgoing details) =+  breadcrumb+    { Bugsnag.breadcrumb_type = Bugsnag.requestBreadcrumbType,+      Bugsnag.breadcrumb_metaData =+        Bugsnag.breadcrumb_metaData breadcrumb ++ Just (Helpers.toHashMap details)+    }++sqlQueryAsBreadcrumb :: Bugsnag.Breadcrumb -> SqlQuery.Details -> Bugsnag.Breadcrumb+sqlQueryAsBreadcrumb breadcrumb details =+  breadcrumb+    { Bugsnag.breadcrumb_type = Bugsnag.requestBreadcrumbType,+      Bugsnag.breadcrumb_metaData =+        Bugsnag.breadcrumb_metaData breadcrumb ++ Just (Helpers.toHashMap details)+    }++redisQueryAsBreadcrumb :: Bugsnag.Breadcrumb -> RedisCommands.Details -> Bugsnag.Breadcrumb+redisQueryAsBreadcrumb breadcrumb details =+  breadcrumb+    { Bugsnag.breadcrumb_type = Bugsnag.requestBreadcrumbType,+      Bugsnag.breadcrumb_metaData =+        Bugsnag.breadcrumb_metaData breadcrumb ++ Just (Helpers.toHashMap details)+    }++logAsBreadcrumb :: Platform.TracingSpan -> Bugsnag.Breadcrumb -> Log.LogContexts -> Bugsnag.Breadcrumb+logAsBreadcrumb span breadcrumb details =+  breadcrumb+    { Bugsnag.breadcrumb_type =+        if List.isEmpty (Platform.children span)+          then Bugsnag.logBreadcrumbType+          else Bugsnag.processBreadcrumbType,+      Bugsnag.breadcrumb_metaData =+        Bugsnag.breadcrumb_metaData breadcrumb ++ Just (Helpers.toHashMap details)+    }++unknownAsBreadcrumb :: Bugsnag.Breadcrumb -> Platform.SomeTracingSpanDetails -> Bugsnag.Breadcrumb+unknownAsBreadcrumb breadcrumb details =+  breadcrumb+    { Bugsnag.breadcrumb_type = Bugsnag.manualBreadcrumbType,+      Bugsnag.breadcrumb_metaData =+        Bugsnag.breadcrumb_metaData breadcrumb ++ Just (Helpers.toHashMap details)+    }++decorateEventWithTracingSpanData :: Platform.TracingSpan -> Bugsnag.Event -> Bugsnag.Event+decorateEventWithTracingSpanData span event =+  Platform.details span+    |> Maybe.andThen+      ( Platform.renderTracingSpanDetails+          [ Platform.Renderer (renderIncomingHttpRequest event),+            Platform.Renderer (renderLog event),+            Platform.Renderer (renderRemainingTracingSpanDetails span event)+          ]+      )+    |> Maybe.withDefault event++renderRemainingTracingSpanDetails :: Platform.TracingSpan -> Bugsnag.Event -> Platform.SomeTracingSpanDetails -> Bugsnag.Event+renderRemainingTracingSpanDetails span event details =+  event+    { Bugsnag.event_metaData =+        Aeson.toJSON details+          |> HashMap.singleton (Platform.name span)+          |> Just+          |> (++) (Bugsnag.event_metaData event)+    }++renderLog :: Bugsnag.Event -> Log.LogContexts -> Bugsnag.Event+renderLog event details =+  event+    { Bugsnag.event_metaData =+        Aeson.toJSON details+          |> HashMap.singleton "custom"+          |> HashMap.unionWith+            mergeJson+            (Bugsnag.event_metaData event |> Maybe.withDefault HashMap.empty)+          |> Just+    }++mergeJson :: Aeson.Value -> Aeson.Value -> Aeson.Value+mergeJson (Aeson.Object x) (Aeson.Object y) = Aeson.Object (HashMap.unionWith mergeJson x y)+mergeJson _ last = last++mergeMetaData ::+  Maybe (HashMap.HashMap Text Aeson.Value) ->+  Maybe (HashMap.HashMap Text Aeson.Value) ->+  Maybe (HashMap.HashMap Text Aeson.Value)+mergeMetaData Nothing x = x+mergeMetaData x Nothing = x+mergeMetaData (Just x) (Just y) = Just (HashMap.unionWith mergeJson x y)++renderIncomingHttpRequest ::+  Bugsnag.Event ->+  HttpRequest.Incoming ->+  Bugsnag.Event+renderIncomingHttpRequest event (HttpRequest.Incoming request) =+  event+    { Bugsnag.event_context = HttpRequest.endpoint request,+      Bugsnag.event_request =+        Just+          Bugsnag.defaultRequest+            { Bugsnag.request_httpMethod = HttpRequest.method request,+              Bugsnag.request_headers =+                HttpRequest.headers request+                  |> Dict.toList+                  |> HashMap.fromList+                  |> 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.+      Bugsnag.event_metaData =+        mergeMetaData+          (Bugsnag.event_metaData event)+          ( [ "endpoint" .= HttpRequest.endpoint request,+              "http version" .= HttpRequest.httpVersion request,+              "response status" .= HttpRequest.status request,+              "path" .= HttpRequest.path request,+              "query string" .= HttpRequest.queryString request+            ]+              |> Aeson.object+              |> HashMap.singleton "request"+              |> Just+          )+    }++failed :: Platform.TracingSpan -> Bool+failed span =+  case Platform.succeeded span of+    Platform.Succeeded -> False+    Platform.Failed -> True+    Platform.FailedWith _ -> True++toException :: [Bugsnag.StackFrame] -> Platform.TracingSpan -> Bugsnag.Exception+toException frames span =+  case Platform.succeeded span of+    Platform.Succeeded -> Bugsnag.defaultException+    Platform.Failed ->+      Bugsnag.defaultException+        { Bugsnag.exception_errorClass = Platform.name span,+          Bugsnag.exception_stacktrace = frames+        }+    Platform.FailedWith (Exception.SomeException exception) ->+      Bugsnag.defaultException+        { Bugsnag.exception_errorClass = typeName exception,+          Bugsnag.exception_stacktrace = frames,+          Bugsnag.exception_message =+            Exception.displayException exception+              |> Text.fromList+              |> Just+        }++toStackFrame :: Text -> Stack.SrcLoc -> Bugsnag.StackFrame+toStackFrame functionName frame =+  Bugsnag.defaultStackFrame+    { Bugsnag.stackFrame_file = Text.fromList (Stack.srcLocFile frame),+      Bugsnag.stackFrame_lineNumber = Stack.srcLocStartLine frame,+      Bugsnag.stackFrame_columnNumber = Just (Stack.srcLocStartCol frame),+      Bugsnag.stackFrame_method = functionName,+      Bugsnag.stackFrame_inProject = Just True+    }++typeName :: forall a. Typeable.Typeable a => a -> Text+typeName _ =+  Typeable.typeRep (Proxy.Proxy :: Proxy.Proxy a)+    |> Prelude.show+    |> 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@] LOG_FILE+    -- [@default value@] app.log+    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+    appName :: Namespace,+    -- | The environment this application is running in. This will be attached+    -- to all bugsnage reports.+    --+    -- [@environment variable@] ENVIRONMENT+    -- [@default value@] development+    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 =+  Prelude.pure Settings+    |> andMap apiKeyDecoder+    |> andMap namespaceDecoder+    |> andMap environmentDecoder++apiKeyDecoder :: Environment.Decoder (Log.Secret Bugsnag.ApiKey)+apiKeyDecoder =+  Environment.variable+    Environment.Variable+      { Environment.name = "BUGSNAG_API_KEY",+        Environment.description = "The API key of the Bugsnag project we should send items too.",+        Environment.defaultValue = "*****"+      }+    (Environment.text |> map Bugsnag.apiKey |> Environment.secret)++newtype Namespace = Namespace {unNamespace :: Text}++namespaceDecoder :: Environment.Decoder Namespace+namespaceDecoder =+  Environment.variable+    Environment.Variable+      { Environment.name = "LOG_ROOT_NAMESPACE",+        Environment.description = "Root of the log namespace. This should be the name of the application.",+        Environment.defaultValue = "your-application-name-here"+      }+    (map Namespace Environment.text)++newtype Environment = Environment {unEnvironment :: Text}++environmentDecoder :: Environment.Decoder Environment+environmentDecoder =+  Environment.variable+    Environment.Variable+      { Environment.name = "ENVIRONMENT",+        Environment.description = "Environment to display in logs.",+        Environment.defaultValue = "development"+      }+    (map Environment Environment.text)++mkDefaultEvent :: Settings -> Prelude.IO Bugsnag.Event+mkDefaultEvent settings = do+  revision <- getRevision+  hostname <- Network.HostName.getHostName+  let appId = unNamespace (appName settings)+  let app =+        Bugsnag.defaultApp+          { Bugsnag.app_id = Just appId,+            -- Same format as what bugsnag-build-notify uses for appVersion+            Bugsnag.app_version = Just (appId ++ "-" ++ unRevision revision),+            Bugsnag.app_releaseStage = Just (unEnvironment (appEnvironment settings)),+            Bugsnag.app_type = Just "haskell"+          }+  let device =+        Bugsnag.defaultDevice+          { Bugsnag.device_hostname = Just (Text.fromList hostname)+          }+  Prelude.pure+    Bugsnag.defaultEvent+      { Bugsnag.event_app = Just app,+        Bugsnag.event_device = Just device+      }++newtype Revision = Revision {unRevision :: Text}++getRevision :: Prelude.IO Revision+getRevision = do+  eitherRevision <- Exception.tryAny <| Data.Text.IO.readFile "revision"+  case eitherRevision of+    Prelude.Left _err -> Prelude.pure (Revision "no revision file found")+    Prelude.Right version -> Prelude.pure (Revision version)

@@ -0,0 +1,19 @@+-- | Reporting for development+--+-- This reporter logs basic information about requests in a human-readable+-- format, for use in a development console.+--+-- The development logs produced are quite sparse. To dig deeper this reporter+-- will also make tracing data available in the log-explorer tool. You can find+-- it here:+--+-- <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-log-explorer>+module Reporter.Dev+  ( Internal.report,+    Internal.Handler,+    Internal.handler,+    Internal.cleanup,+  )+where++import qualified Reporter.Dev.Internal as Internal

@@ -0,0 +1,114 @@+{-# LANGUAGE NumericUnderscores #-}++module Reporter.Dev.Internal where++import qualified Control.Concurrent+import qualified Control.Concurrent.Async as Async+import qualified Control.Concurrent.MVar as MVar+import qualified Control.Exception.Safe as Exception+import qualified Data.Text.IO+import qualified Data.Text.Lazy+import qualified Data.Text.Lazy.Builder as Builder+import qualified Log.HttpRequest as HttpRequest+import qualified Platform+import qualified Platform.Timer as Timer+import qualified Prelude++-- Print basic information about requests to stdout and make more detailed+-- information available to the log-explorer tool.+--+-- Example usage:+-- > handler <- Dev.handler+-- > Dev.report handler "request-id" span+report :: Handler -> Text -> Platform.TracingSpan -> Prelude.IO ()+report handler' _requestId span = do+  Platform.writeSpanToDevLog span+  MVar.putMVar (writeLock handler') (mkLog (timer handler') span)++mkLog :: Timer.Timer -> Platform.TracingSpan -> Builder.Builder+mkLog timer span =+  time timer span+    ++ " "+    ++ name span+    ++ " "+    ++ failed span++time :: Timer.Timer -> Platform.TracingSpan -> Builder.Builder+time timer span =+  Timer.toLocal timer (Platform.started span)+    |> Prelude.show+    |> Builder.fromString++name :: Platform.TracingSpan -> Builder.Builder+name span =+  Platform.details span+    |> Maybe.andThen+      ( Platform.renderTracingSpanDetails+          [ Platform.Renderer nameIncomingRequest+          ]+      )+    |> Maybe.withDefault (Builder.fromText (Platform.name span))++nameIncomingRequest :: HttpRequest.Incoming -> Builder.Builder+nameIncomingRequest (HttpRequest.Incoming details) =+  HttpRequest.endpoint details+    |> Maybe.withDefault "Incoming HTTP request"+    |> Builder.fromText++failed :: Platform.TracingSpan -> Builder.Builder+failed span =+  case Platform.succeeded span of+    Platform.Succeeded -> ""+    Platform.Failed -> "❌"+    Platform.FailedWith err ->+      "❌\n"+        ++ Builder.fromString (Exception.displayException err)++data Handler = Handler+  { timer :: Timer.Timer,+    -- If we let each request log to stdout directly the result will be lots+    -- of unreadable interleaved output from requests that are handled+    -- concurrently. To prevent this we use an MVar as a lock.+    --+    -- After a request is done it can write it's log to the MVar. If the+    -- MVar already contains a log this operation will block until the MVar+    -- is empty. We have a logging thread running separately that takes logs+    -- from the MVar and prints them to stdout one at a time.+    writeLock :: MVar.MVar Builder.Builder,+    loggingThread :: Async.Async ()+  }++-- | Create a 'Handler'. Do this once when your application starts and reuse+-- the 'Handler' you get.+handler :: Prelude.IO Handler+handler = do+  writeLock <- MVar.newEmptyMVar+  counter <- MVar.newMVar 0+  loggingThread <- Async.async (logLoop counter writeLock)+  timer <- Timer.mkTimer+  Prelude.pure Handler {timer, writeLock, loggingThread}++-- | Clean up your handler after you're done with it. Call this before your+-- application shuts down.+cleanup :: Handler -> Prelude.IO ()+cleanup = Async.cancel << loggingThread++-- | Waits for a log message to become available in the MVar, logs it, then+-- waits for the next one. This is intended to be ran on a separate thread.+logLoop :: MVar.MVar Int -> MVar.MVar Builder.Builder -> Prelude.IO ()+logLoop counter lock = do+  line <- MVar.takeMVar lock+  Builder.toLazyText line+    |> Data.Text.Lazy.toStrict+    |> Data.Text.IO.putStrLn+  ownCount <- MVar.modifyMVar counter (\n -> Prelude.pure (n + 1, n + 1))+  Async.concurrently_+    (logLoop counter lock)+    ( do+        -- After a few seconds of inactivity, advertise for log-explorer.+        Control.Concurrent.threadDelay 3_000_000 {- 3 seconds -}+        currentCount <- MVar.readMVar counter+        if ownCount == currentCount+          then Prelude.putStrLn "🕵️ Need more detail? Try running the `log-explorer` command!\n"+          else Prelude.pure ()+    )

@@ -0,0 +1,26 @@+-- | Reporting to a file.+--+-- This reporter logs debugging information about completed requests to a file+-- or `stdout` (in that case, pass in `/dev/stdout` as the file to log to).+--+-- Every line this reporter logs is a JSON string. This 'structured logging'+-- output is optimized for external logging platforms that display these logs in+-- a pretty UI.+--+-- This logger supports sampling of successful requests, to help save money when+-- sending logs to external services.+module Reporter.File+  ( Internal.report,+    Internal.Handler,+    Internal.handler,+    Internal.cleanup,+    Internal.Settings,+    Internal.decoder,+    Internal.logFile,+    Internal.appName,+    Internal.appEnvironment,+    Internal.fractionOfSuccessRequestsLogged,+  )+where++import qualified Reporter.File.Internal as Internal

@@ -0,0 +1,222 @@+module Reporter.File.Internal where++import qualified Control.Concurrent.Async as Async+import qualified Control.Concurrent.STM as STM+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Encoding+import qualified Data.ByteString.Lazy as ByteString+import qualified Data.Foldable+import qualified Environment+import qualified Network.HostName+import qualified Platform+import qualified Platform.ReporterHelpers as Helpers+import qualified Platform.Timer as Timer+import qualified System.IO+import qualified System.Random as Random+import qualified Prelude++-- Log tracing information for a request to a file. Tracing information contains+-- nested spans but will appear flattend in the log. Each tracing span will+-- appear on its own line in the log, ordered by its start date.+--+-- Example usage:+--+-- > settings <- File.decode+-- > handler <- File.handler settings+-- > File.report handler "request-id" span+report :: Handler -> Text -> Platform.TracingSpan -> Prelude.IO ()+report Handler {skipLogging, writeQueue, logContext} requestId span = do+  skip <- skipLogging span+  if skip+    then Prelude.pure ()+    else+      logItemRecursively logContext {requestId} span []+        |> STM.writeTBQueue writeQueue+        |> (`STM.orElse` Prelude.pure ()) -- Drop the log if the queue is full.+        |> STM.atomically++logItemRecursively ::+  LogContext ->+  Platform.TracingSpan ->+  [ByteString.ByteString] ->+  [ByteString.ByteString]+logItemRecursively logContext span acc =+  logItemRecursivelyHelper logContext span acc+    |> List.reverse++logItemRecursivelyHelper ::+  LogContext ->+  Platform.TracingSpan ->+  [ByteString.ByteString] ->+  [ByteString.ByteString]+logItemRecursivelyHelper logContext span acc =+  List.foldr -- The right-most child is the oldest, so that's where we start+    ( logItemRecursivelyHelper+        logContext+          { namespace = Platform.name span : namespace logContext+          }+    )+    (logItem logContext span : acc)+    (Platform.children span)++logItem :: LogContext -> Platform.TracingSpan -> ByteString.ByteString+logItem LogContext {timer, namespace, environment, requestId, hostname} span =+  (Aeson..=) "name" (Platform.name span)+    ++ (Aeson..=) "start_utc" (Timer.toUTC timer (Platform.started span))+    ++ (Aeson..=) "duration_ms" (Prelude.fromIntegral (Timer.durationInUs span) / 1000)+    ++ (Aeson..=) "env" environment+    ++ (Aeson..=) "namespace" namespace+    ++ (Aeson..=) "request-id" requestId+    ++ (Aeson..=) "hostname" hostname+    ++ ( case Platform.frame span of+           Nothing -> Prelude.mempty+           Just (_, srcLoc) ->+             (Aeson..=) "src" (Helpers.srcString srcLoc)+       )+    ++ (Aeson..=) "allocated_mb" (toFloat (Platform.allocated span) / 1e6)+    ++ (Aeson..=) "details" (Platform.details span)+      |> Aeson.pairs+      |> Data.Aeson.Encoding.encodingToLazyByteString++data Handler = Handler+  { fileHandle :: System.IO.Handle,+    logContext :: LogContext,+    skipLogging :: Platform.TracingSpan -> Prelude.IO Bool,+    writeQueue :: STM.TBQueue [ByteString.ByteString],+    loggingThread :: Async.Async ()+  }++data LogContext = LogContext+  { timer :: Timer.Timer,+    namespace :: [Text],+    environment :: Text,+    requestId :: Text,+    hostname :: Text+  }++-- | 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 = do+  let skipLogging span =+        case Platform.succeeded span of+          Platform.Succeeded -> do+            roll <- Random.randomRIO (0.0, 1.0)+            Prelude.pure (roll > fractionOfSuccessRequestsLogged settings)+          Platform.Failed -> Prelude.pure False+          Platform.FailedWith _ -> Prelude.pure False+  fileHandle <- System.IO.openFile (logFile settings) System.IO.AppendMode+  hostname <- map Text.fromList Network.HostName.getHostName+  writeQueue <- STM.atomically (STM.newTBQueue 100)+  loggingThread <- Async.async (logLoop writeQueue fileHandle)+  timer <- Timer.mkTimer+  let logContext =+        LogContext+          { timer,+            hostname,+            requestId = "", -- This changes per request and so is set later.+            namespace = [appName settings],+            environment = appEnvironment settings+          }+  Prelude.pure+    Handler+      { fileHandle,+        skipLogging,+        writeQueue,+        loggingThread,+        logContext+      }++logLoop ::+  STM.TBQueue [ByteString.ByteString] ->+  System.IO.Handle ->+  Prelude.IO ()+logLoop writeQueue fileHandle = do+  lines <- STM.atomically (STM.readTBQueue writeQueue)+  Data.Foldable.for_ lines <| \line -> do+    ByteString.hPut fileHandle line+    ByteString.hPut fileHandle "\n"+  logLoop writeQueue fileHandle++cleanup :: Handler -> Prelude.IO ()+cleanup Handler {loggingThread, fileHandle} = do+  Async.cancel loggingThread+  System.IO.hClose fileHandle++-- | Configuration settings for this reporter. A value of this type can be read+-- from the environment using the 'decoder' function.+data Settings = Settings+  { -- | The file to log too. On unix systems you can set this to @/dev/stdout@+    -- in order to log to stdout.+    --+    -- [@environment variable@] LOG_FILE+    -- [@default value@] app.log+    logFile :: Prelude.FilePath,+    -- | The name of this application. This will be attached to all logs.+    --+    -- [@environment variable@] LOG_ROOT_NAMESPACE+    -- [@default value@] your-application-name-here+    appName :: Text,+    -- | The environment this application is running in. This will be attached+    -- to all logs.+    --+    -- [@environment variable@] ENVIRONMENT+    -- [@default value@] development+    appEnvironment :: Text,+    -- | The fraction of requests that should be logged. Set to 1 if you want to+    -- log everything, and a lower value to save money.+    --+    -- [@environment variable@] FRACTION_OF_SUCCESS_REQUESTS_LOGGED+    -- [@default value@] 1+    fractionOfSuccessRequestsLogged :: Float+  }++-- | 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 =+  Prelude.pure Settings+    |> andMap logFileDecoder+    |> andMap appNameDecoder+    |> andMap environmentDecoder+    |> andMap fractionOfSuccessRequestsLoggedDecoder++logFileDecoder :: Environment.Decoder Prelude.FilePath+logFileDecoder =+  Environment.variable+    Environment.Variable+      { Environment.name = "LOG_FILE",+        Environment.description = "File to log too.",+        Environment.defaultValue = "app.log"+      }+    Environment.filePath++appNameDecoder :: Environment.Decoder Text+appNameDecoder =+  Environment.variable+    Environment.Variable+      { Environment.name = "LOG_ROOT_NAMESPACE",+        Environment.description = "Root of the log namespace. This should be the name of the application.",+        Environment.defaultValue = "your-application-name-here"+      }+    Environment.text++environmentDecoder :: Environment.Decoder Text+environmentDecoder =+  Environment.variable+    Environment.Variable+      { Environment.name = "ENVIRONMENT",+        Environment.description = "Environment to display in logs.",+        Environment.defaultValue = "development"+      }+    Environment.text++fractionOfSuccessRequestsLoggedDecoder :: Environment.Decoder Float+fractionOfSuccessRequestsLoggedDecoder =+  Environment.variable+    Environment.Variable+      { Environment.name = "FRACTION_OF_SUCCESS_REQUESTS_LOGGED",+        Environment.description = "The fraction of successful requests logged. Defaults to logging all successful requests.",+        Environment.defaultValue = "1"+      }+    Environment.float

@@ -0,0 +1,21 @@+module Main (main) where++import qualified Spec.Platform.Timer+import qualified Spec.Reporter.Bugsnag+import qualified Spec.Reporter.Dev+import qualified Spec.Reporter.File+import qualified Test+import qualified Prelude++main :: Prelude.IO ()+main = Test.run tests++tests :: Test.Test+tests =+  Test.describe+    "nri-observability"+    [ Spec.Platform.Timer.tests,+      Spec.Reporter.Bugsnag.tests,+      Spec.Reporter.Dev.tests,+      Spec.Reporter.File.tests+    ]

@@ -0,0 +1,27 @@+module Spec.Platform.Timer (tests) where++import qualified Data.Time.Clock.POSIX as Clock.POSIX+import qualified Expect+import qualified GHC.Clock+import qualified Platform.Timer as Timer+import qualified Test+import qualified Prelude++tests :: Test.Test+tests =+  Test.describe+    "Observability.Timer"+    [ Test.test "can reproduce the current time" <| \_ -> do+        timer <- Expect.fromIO <| Timer.mkTimer+        clock <-+          GHC.Clock.getMonotonicTimeNSec+            |> map (\t -> Prelude.fromIntegral (t `Prelude.div` 1000))+            |> Expect.fromIO+        expectedNow <- Expect.fromIO <| Clock.POSIX.getPOSIXTime+        let actualNow = Timer.toPosix timer clock+        actualNow+          |> Expect.all+            [ Expect.atLeast (expectedNow - 1),+              Expect.atMost (expectedNow + 1)+            ]+    ]

@@ -0,0 +1,444 @@+module Spec.Reporter.Bugsnag (tests) where++import qualified Control.Exception.Safe as Exception+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Encode.Pretty+import qualified Data.ByteString.Lazy+import qualified Data.Text.Encoding+import qualified Data.Time.LocalTime as LocalTime+import qualified Dict+import qualified Expect+import qualified GHC.Stack as Stack+import qualified Log+import qualified Log.HttpRequest as HttpRequest+import qualified Log.RedisCommands as RedisCommands+import qualified Log.SqlQuery as SqlQuery+import qualified Network.Bugsnag+import qualified Platform+import qualified Platform.Timer as Timer+import qualified Reporter.Bugsnag.Internal as Bugsnag+import Test (Test, describe, test)+import qualified Prelude++tests :: Test+tests =+  describe+    "Observability.Bugsnag"+    [ test "encodes span marked as failed as an exception" <| \_ ->+        emptyTracingSpan+          { Platform.name = "root span",+            Platform.succeeded = Platform.Failed+          }+          |> encodesTo "bugsnag-failure-without-exception",+      test "if an exception was thrown use that exceptions name" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded =+              Platform.FailedWith (Exception.SomeException (CustomException "something went wrong"))+          }+          |> encodesTo "bugsnag-failure-with-exception",+      test "identifies the most recently started failing span as the root cause failure" <| \_ ->+        emptyTracingSpan+          { Platform.name = "parent of root cause",+            Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.name = "after root cause",+                    Platform.succeeded = Platform.Succeeded+                  },+                emptyTracingSpan+                  { Platform.name = "root cause",+                    Platform.succeeded = Platform.Failed,+                    Platform.children =+                      [ emptyTracingSpan+                          { Platform.name = "child of root cause",+                            Platform.succeeded = Platform.Succeeded+                          }+                      ]+                  },+                emptyTracingSpan+                  { Platform.name = "before root cause",+                    Platform.succeeded = Platform.Succeeded+                  }+              ]+          }+          |> encodesTo "bugsnag-failure-with-root-cause",+      test "shows stack trace from the root span to the root cause span" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.frame = Just ("function1", Stack.SrcLoc "package1" "Module2" "Filename1.hs" 0 1 2 3),+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.frame = Just ("function2", Stack.SrcLoc "package2" "Module2" "Filename2.hs" 10 11 12 13)+                  },+                emptyTracingSpan+                  { Platform.succeeded = Platform.Failed,+                    Platform.frame = Just ("function3", Stack.SrcLoc "package3" "Module3" "Filename3.hs" 20 21 22 23),+                    Platform.children =+                      [ emptyTracingSpan+                          { Platform.succeeded = Platform.Succeeded,+                            Platform.frame = Just ("function4", Stack.SrcLoc "package4" "Module4" "Filename4.hs" 30 31 32 33)+                          }+                      ]+                  },+                emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.frame = Just ("function5", Stack.SrcLoc "package5" "Module5" "Filename5.hs" 40 41 42 43)+                  }+              ]+          }+          |> encodesTo "bugsnag-failure-stack-trace",+      test "encodes information about an incoming http request" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.details =+              HttpRequest.emptyDetails+                { HttpRequest.httpVersion = Just "1",+                  HttpRequest.method = Just "GET",+                  HttpRequest.path = Just "/hats/5",+                  HttpRequest.queryString = Just "?top=flat",+                  HttpRequest.endpoint = Just "GET /hats/:hat_id",+                  HttpRequest.headers = Dict.fromList [("Accept", "application/json")],+                  HttpRequest.status = Just 500+                }+                |> HttpRequest.Incoming+                |> Platform.toTracingSpanDetails+                |> Just+          }+          |> encodesTo "bugsnag-failure-incoming-http-request",+      test "renders sql query failures correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.details =+              SqlQuery.emptyDetails+                { SqlQuery.query = Just (Log.mkSecret "SELECT name FROM ants WHERE id = 3"),+                  SqlQuery.databaseType = Just SqlQuery.postgresql,+                  SqlQuery.queryTemplate = Just "SELECT name FROM ants WHERE id = ${id}",+                  SqlQuery.sqlOperation = Just "SELECT",+                  SqlQuery.queriedRelation = Just "ants",+                  SqlQuery.host = Just "http://antsonline.com",+                  SqlQuery.port = Just 5432,+                  SqlQuery.database = Just "nri",+                  SqlQuery.rowsReturned = Just 5+                }+                |> Platform.toTracingSpanDetails+                |> Just+          }+          |> encodesTo "bugsnag-failure-sql",+      test "renders redis query failures correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.details =+              RedisCommands.emptyDetails+                { RedisCommands.host = Just "cache.noredink.com",+                  RedisCommands.port = Just 6379,+                  RedisCommands.commands = ["GET somekey"]+                }+                |> Platform.toTracingSpanDetails+                |> Just+          }+          |> encodesTo "bugsnag-failure-redis",+      test "renders outgoing http request failures correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Failed,+                    Platform.details =+                      HttpRequest.emptyDetails+                        { HttpRequest.host = Just "http://antsonline.com",+                          HttpRequest.path = Just "/bulletin",+                          HttpRequest.method = Just "GET"+                        }+                        |> HttpRequest.Outgoing+                        |> Platform.toTracingSpanDetails+                        |> Just+                  }+              ]+          }+          |> encodesTo "bugsnag-failure-http",+      test "renders log failures correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.name = "log message",+            Platform.details =+              Log.LogContexts+                [ Log.context "number" (4 :: Int),+                  Log.context "text" ("Hi!" :: Text)+                ]+                |> Platform.toTracingSpanDetails+                |> Just+          }+          |> encodesTo "bugsnag-failure-log",+      test "renders withContext failures correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.name = "some context",+            Platform.details =+              Log.LogContexts+                [ Log.context "number" (4 :: Int)+                ]+                |> Platform.toTracingSpanDetails+                |> Just,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded+                  }+              ]+          }+          |> encodesTo "bugsnag-failure-with-context",+      test "merges unknown span details from nested spans into metadata" <| \_ ->+        emptyTracingSpan+          { Platform.name = "measure weather",+            Platform.succeeded = Platform.Failed,+            Platform.details =+              CustomDetails "32 C"+                |> Platform.toTracingSpanDetails+                |> Just,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.name = "measure humidity",+                    Platform.succeeded = Platform.Failed,+                    Platform.details =+                      CustomDetails "25 %"+                        |> Platform.toTracingSpanDetails+                        |> Just+                  }+              ]+          }+          |> encodesTo "bugsnag-failure-unknown",+      test "non-failing spans are encoded as breadcrumbs in the right order" <| \_ ->+        emptyTracingSpan+          { Platform.name = "root-span (failed)",+            Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.name = "child-3 (leaf)",+                    Platform.succeeded = Platform.Succeeded+                  },+                emptyTracingSpan+                  { Platform.name = "child-2 (failed)",+                    Platform.succeeded = Platform.Failed,+                    Platform.children =+                      [ emptyTracingSpan+                          { Platform.name = "child-3-grandchild-3 (failed, root cause)",+                            Platform.succeeded = Platform.Failed,+                            Platform.children =+                              [ emptyTracingSpan+                                  { Platform.name = "child-3-grandchild-3-greatgrandchild-2 (leaf)",+                                    Platform.succeeded = Platform.Succeeded+                                  },+                                emptyTracingSpan+                                  { Platform.name = "child-3-grandchild-3-greatgrandchild-1 (leaf)",+                                    Platform.succeeded = Platform.Succeeded+                                  }+                              ]+                          },+                        emptyTracingSpan+                          { Platform.name = "child-2-grandchild-2",+                            Platform.succeeded = Platform.Succeeded,+                            Platform.children =+                              [ emptyTracingSpan+                                  { Platform.name = "child-2-grandchild-2-greatgrandchild-2 (leaf)",+                                    Platform.succeeded = Platform.Failed+                                  },+                                emptyTracingSpan+                                  { Platform.name = "child-2-grandchild-2-greatgrandchild-1 (leaf)",+                                    Platform.succeeded = Platform.Succeeded+                                  }+                              ]+                          },+                        emptyTracingSpan+                          { Platform.name = "child-2-grandchild-1 (leaf)",+                            Platform.succeeded = Platform.Succeeded+                          }+                      ]+                  },+                emptyTracingSpan+                  { Platform.name = "child-1 (leaf)",+                    Platform.succeeded = Platform.Succeeded+                  }+              ]+          }+          |> encodesTo "bugsnag-breadcrumbs-right-order",+      test "renders sql query breadcrumbs correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.details =+                      SqlQuery.emptyDetails+                        { SqlQuery.query = Just (Log.mkSecret "SELECT name FROM ants WHERE id = 3"),+                          SqlQuery.databaseType = Just SqlQuery.postgresql,+                          SqlQuery.queryTemplate = Just "SELECT name FROM ants WHERE id = ${id}",+                          SqlQuery.sqlOperation = Just "SELECT",+                          SqlQuery.queriedRelation = Just "ants",+                          SqlQuery.host = Just "http://antsonline.com",+                          SqlQuery.port = Just 5432,+                          SqlQuery.database = Just "nri",+                          SqlQuery.rowsReturned = Just 5+                        }+                        |> Platform.toTracingSpanDetails+                        |> Just+                  }+              ]+          }+          |> encodesTo "bugsnag-breadcrumbs-sql",+      test "renders redis query breadcrumbs correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.details =+                      RedisCommands.emptyDetails+                        { RedisCommands.host = Just "cache.noredink.com",+                          RedisCommands.port = Just 6379,+                          RedisCommands.commands = ["GET somekey"]+                        }+                        |> Platform.toTracingSpanDetails+                        |> Just+                  }+              ]+          }+          |> encodesTo "bugsnag-breadcrumbs-redis",+      test "renders outgoing http request breadcrumbs correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.children =+                      [ emptyTracingSpan+                          { Platform.succeeded = Platform.Succeeded,+                            Platform.details =+                              HttpRequest.emptyDetails+                                { HttpRequest.host = Just "http://antsonline.com",+                                  HttpRequest.path = Just "/bulletin",+                                  HttpRequest.method = Just "GET"+                                }+                                |> HttpRequest.Outgoing+                                |> Platform.toTracingSpanDetails+                                |> Just+                          }+                      ]+                  }+              ]+          }+          |> encodesTo "bugsnag-breadcrumbs-http",+      test "renders log breadcrumbs correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.details =+                      Log.LogContexts+                        [ Log.context "number" (4 :: Int),+                          Log.context "text" ("Hi!" :: Text)+                        ]+                        |> Platform.toTracingSpanDetails+                        |> Just+                  }+              ]+          }+          |> encodesTo "bugsnag-breadcrumbs-log",+      test "renders withContext breadcrumbs correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.details =+                      Log.LogContexts+                        [ Log.context "number" (4 :: Int)+                        ]+                        |> Platform.toTracingSpanDetails+                        |> Just,+                    Platform.children =+                      [ emptyTracingSpan+                          { Platform.succeeded = Platform.Succeeded+                          }+                      ]+                  }+              ]+          }+          |> encodesTo "bugsnag-breadcrumbs-with-context",+      test "renders unknown spans breadcrumbs correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.details =+                      CustomDetails "The deets!"+                        |> Platform.toTracingSpanDetails+                        |> Just+                  }+              ]+          }+          |> encodesTo "bugsnag-breadcrumbs-unknown",+      test "renders timestamps correctly" <| \_ ->+        emptyTracingSpan+          { Platform.succeeded = Platform.Failed,+            Platform.started = ms 4,+            Platform.finished = ms 9, -- 8 ms+            Platform.children =+              [ emptyTracingSpan+                  { Platform.succeeded = Platform.Succeeded,+                    Platform.name = "outer",+                    Platform.started = ms 5,+                    Platform.finished = ms 8, -- 8 ms+                    Platform.children =+                      [ emptyTracingSpan+                          { Platform.succeeded = Platform.Succeeded,+                            Platform.name = "inner",+                            Platform.started = ms 6, -- 6 ms+                            Platform.finished = ms 7, -- 7 ms+                            Platform.children =+                              []+                          }+                      ]+                  }+              ]+          }+          |> encodesTo "bugsnag-breadcrumbs-timestamps"+    ]++newtype CustomException = CustomException Text deriving (Show)++instance Exception.Exception CustomException++newtype CustomDetails = CustomDetails Text+  deriving (Aeson.ToJSON)++instance Platform.TracingSpanDetails CustomDetails++ms :: Int -> Platform.MonotonicTime+ms n = Prelude.fromIntegral (n * 1000)++timer :: Timer.Timer+timer = Timer.Timer 0 LocalTime.utc++emptyTracingSpan :: Platform.TracingSpan+emptyTracingSpan =+  Platform.emptyTracingSpan+    { Platform.name = "some span",+      Platform.started = 0,+      Platform.finished = 0,+      Platform.frame = Nothing,+      Platform.details = Nothing,+      Platform.succeeded = Platform.Succeeded,+      Platform.allocated = 0,+      Platform.children = []+    }++encodesTo :: Text -> Platform.TracingSpan -> Expect.Expectation+encodesTo filename span =+  span+    |> Bugsnag.toEvent "request-id-1234" timer Network.Bugsnag.defaultEvent+    |> Data.Aeson.Encode.Pretty.encodePretty+    |> Data.ByteString.Lazy.toStrict+    |> Data.Text.Encoding.decodeUtf8+    |> Expect.equalToContentsOf ("tests/golden-results/" ++ filename ++ ".json")

@@ -0,0 +1,76 @@+module Spec.Reporter.Dev (tests) where++import qualified Control.Exception.Safe as Exception+import qualified Data.Text.Lazy+import qualified Data.Text.Lazy.Builder+import qualified Data.Time.LocalTime as LocalTime+import qualified Expect+import qualified Log.HttpRequest as HttpRequest+import qualified Platform+import qualified Platform.Timer as Timer+import qualified Reporter.Dev.Internal as Dev+import qualified Test+import qualified Prelude++tests :: Test.Test+tests =+  Test.describe+    "Observability.Dev"+    [ logTest+        "log span without details or children"+        emptyTracingSpan+          { Platform.name = "root-span",+            Platform.started = ms 5+          },+      logTest+        "log span with exception"+        emptyTracingSpan+          { Platform.name = "root-span",+            Platform.succeeded = Platform.FailedWith (Exception.SomeException (CustomException "toast!"))+          },+      logTest+        "logs information about an incoming http request"+        emptyTracingSpan+          { Platform.details =+              HttpRequest.emptyDetails+                { HttpRequest.endpoint = Just "/hats/:hat_id"+                }+                |> HttpRequest.Incoming+                |> Platform.toTracingSpanDetails+                |> Just+          }+    ]++logTest :: Text -> Platform.TracingSpan -> Test.Test+logTest name span =+  Test.test name <| \_ -> do+    let logfile = Text.replace " " "-" name+    let logpath = "tests/golden-results/dev-reporter-" ++ logfile+    span+      |> Dev.mkLog timer+      |> Data.Text.Lazy.Builder.toLazyText+      |> Data.Text.Lazy.toStrict+      |> Expect.equalToContentsOf logpath++newtype CustomException = CustomException Text deriving (Show)++instance Exception.Exception CustomException++ms :: Int -> Platform.MonotonicTime+ms n = Prelude.fromIntegral (n * 1000)++timer :: Timer.Timer+timer = Timer.Timer 0 LocalTime.utc++emptyTracingSpan :: Platform.TracingSpan+emptyTracingSpan =+  Platform.emptyTracingSpan+    { Platform.name = "Example TracingSpan",+      Platform.started = 0,+      Platform.finished = 0,+      Platform.frame = Nothing,+      Platform.details = Nothing,+      Platform.succeeded = Platform.Succeeded,+      Platform.allocated = 0,+      Platform.children = []+    }

@@ -0,0 +1,186 @@+module Spec.Reporter.File (tests) where++import qualified Control.Exception.Safe as Exception+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Encode.Pretty+import qualified Data.ByteString.Lazy+import qualified Data.Text.Lazy+import qualified Data.Text.Lazy.Encoding+import qualified Data.Time.LocalTime as LocalTime+import qualified Dict+import qualified Expect+import qualified Log.HttpRequest as HttpRequest+import qualified Log.RedisCommands as RedisCommands+import qualified Log.SqlQuery as SqlQuery+import qualified Platform+import qualified Platform.Timer as Timer+import qualified Reporter.File.Internal as File+import qualified Test+import qualified Prelude++tests :: Test.Test+tests =+  Test.describe+    "Observability.FileSpec"+    [ logTest+        "logs span without details or children"+        emptyTracingSpan+          { Platform.name = "root-span",+            Platform.finished = ms 7+          },+      logTest+        "logs span that failed with an exception"+        emptyTracingSpan+          { Platform.name = "root-span",+            Platform.succeeded = Platform.FailedWith (Exception.SomeException (CustomException "help!"))+          },+      logTest+        "logs nested spans"+        emptyTracingSpan+          { Platform.name = "root-span",+            Platform.children =+              [ emptyTracingSpan+                  { Platform.name = "child1",+                    Platform.children =+                      [ emptyTracingSpan+                          { Platform.name = "grandchild",+                            Platform.children = []+                          }+                      ]+                  },+                emptyTracingSpan+                  { Platform.name = "child2",+                    Platform.children = []+                  }+              ]+          },+      logTest+        "logs information about an incoming http request"+        emptyTracingSpan+          { Platform.details =+              HttpRequest.emptyDetails+                { HttpRequest.httpVersion = Just "1",+                  HttpRequest.method = Just "GET",+                  HttpRequest.path = Just "/hats/5",+                  HttpRequest.queryString = Just "?top=flat",+                  HttpRequest.endpoint = Just "/hats/:hat_id",+                  HttpRequest.headers = Dict.fromList [("Accept", "application/json")],+                  HttpRequest.status = Just 500+                }+                |> HttpRequest.Incoming+                |> Platform.toTracingSpanDetails+                |> Just+          },+      logTest+        "logs information about an SQL query"+        emptyTracingSpan+          { Platform.details =+              SqlQuery.emptyDetails+                { SqlQuery.databaseType = Just SqlQuery.postgresql,+                  SqlQuery.query = Just (Log.mkSecret "SELECT name FROM ants WHERE id = ?"),+                  SqlQuery.queryTemplate = Just "SELECT name FROM ants WHERE id = ${id}",+                  SqlQuery.sqlOperation = Just "SELECT",+                  SqlQuery.queriedRelation = Just "ants",+                  SqlQuery.host = Just "http://antsonline.com",+                  SqlQuery.port = Just 5432,+                  SqlQuery.database = Just "nri",+                  SqlQuery.rowsReturned = Just 5+                }+                |> Platform.toTracingSpanDetails+                |> Just+          },+      logTest+        "logs information about a redis query"+        emptyTracingSpan+          { Platform.details =+              RedisCommands.emptyDetails+                { RedisCommands.host = Just "cache.noredink.com",+                  RedisCommands.port = Just 6379,+                  RedisCommands.commands = ["GET somekey"]+                }+                |> Platform.toTracingSpanDetails+                |> Just+          },+      logTest+        "logs information about an outoing http request"+        emptyTracingSpan+          { Platform.details =+              HttpRequest.emptyDetails+                { HttpRequest.httpVersion = Just "1",+                  HttpRequest.method = Just "GET",+                  HttpRequest.path = Just "/hats/5",+                  HttpRequest.queryString = Just "?top=flat",+                  HttpRequest.endpoint = Just "/hats/:hat_id",+                  HttpRequest.headers = Dict.fromList [("Accept", "application/json")],+                  HttpRequest.status = Just 500+                }+                |> HttpRequest.Incoming+                |> Platform.toTracingSpanDetails+                |> Just+          },+      logTest+        "logs log messages"+        emptyTracingSpan+          { Platform.details =+              Log.LogContexts+                [ Log.context "number" (4 :: Int),+                  Log.context "text" ("Hi!" :: Text)+                ]+                |> Platform.toTracingSpanDetails+                |> Just+          }+    ]++logTest :: Text -> Platform.TracingSpan -> Test.Test+logTest name span =+  Test.test name <| \_ -> do+    let logContext =+          File.LogContext+            { File.requestId = "request-id",+              File.namespace = ["app"],+              File.environment = "narnia",+              File.hostname = "some-host",+              File.timer = Timer.Timer 0 LocalTime.utc+            }+    let reEncodingResult =+          File.logItemRecursively logContext span []+            -- Pretty-print each log entry to make test files more readable.+            |> Prelude.traverse reEncodePretty+    case reEncodingResult of+      Err err -> Expect.fail err+      Ok reEncoded ->+        Text.join "\n" reEncoded+          |> Expect.equalToContentsOf+            ( Text.fromList "tests/golden-results/file-reporter-"+                ++ Text.replace " " "-" name+            )++reEncodePretty :: Data.ByteString.Lazy.ByteString -> Result Text Text+reEncodePretty str =+  case Aeson.eitherDecode' str of+    Prelude.Left err -> Err (Text.fromList err)+    Prelude.Right (json :: Aeson.Value) ->+      Data.Aeson.Encode.Pretty.encodePretty json+        |> Data.Text.Lazy.Encoding.decodeUtf8+        |> Data.Text.Lazy.toStrict+        |> Ok++newtype CustomException = CustomException Text deriving (Show)++instance Exception.Exception CustomException++ms :: Int -> Platform.MonotonicTime+ms n = Prelude.fromIntegral (1000 * n)++emptyTracingSpan :: Platform.TracingSpan+emptyTracingSpan =+  Platform.emptyTracingSpan+    { Platform.name = "",+      Platform.started = 0,+      Platform.finished = 0,+      Platform.frame = Nothing,+      Platform.details = Nothing,+      Platform.succeeded = Platform.Succeeded,+      Platform.allocated = 0,+      Platform.children = []+    }