diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# 0.1.1.1 + +- Add `Observability` glue module (still needs better documentation!) + - Adds direct dependency on conduit + # 0.1.1.0 - Add honeycomb.io reporter. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,8 @@ - `Reporter` modules for sending data to various backends. - `Log` modules defining `Details` types for common kinds of tracing spans. +- `Observability` module for a unified way of reporting to multiple targets. -Both can be mixed and matched with `Reporter` and `Details` types defined elsewhere. +`Reporter` and `Log` can be mixed and matched with `Reporter` and `Details` types defined elsewhere. [nri-prelude]: https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-prelude diff --git a/nri-observability.cabal b/nri-observability.cabal --- a/nri-observability.cabal +++ b/nri-observability.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: nri-observability -version: 0.1.1.0 +version: 0.1.1.1 synopsis: Report log spans collected by nri-prelude. description: Please see the README at . category: Web @@ -37,6 +37,7 @@ Reporter.Dev Reporter.File Reporter.Honeycomb + Observability other-modules: Platform.ReporterHelpers Platform.Timer @@ -69,6 +70,7 @@ , base >=4.12.0.0 && <4.16 , bugsnag-hs >=0.1.0.0 && <0.3 , bytestring >=0.10.8.2 && <0.12 + , conduit >=1.3.0 && <1.4 , directory >=1.3.3.0 && <1.4 , hostname ==1.0.* , http-client >=0.6.0 && <0.8 @@ -88,6 +90,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs other-modules: + Spec.Observability Spec.Platform.Timer Spec.Reporter.Bugsnag Spec.Reporter.Dev @@ -97,6 +100,7 @@ Log.Kafka Log.RedisCommands Log.SqlQuery + Observability Platform.ReporterHelpers Platform.Timer Reporter.Bugsnag @@ -134,6 +138,7 @@ , base >=4.12.0.0 && <4.16 , bugsnag-hs >=0.1.0.0 && <0.3 , bytestring >=0.10.8.2 && <0.12 + , conduit >=1.3.0 && <1.4 , directory >=1.3.3.0 && <1.4 , hostname ==1.0.* , http-client >=0.6.0 && <0.8 diff --git a/src/Observability.hs b/src/Observability.hs new file mode 100644 --- /dev/null +++ b/src/Observability.hs @@ -0,0 +1,239 @@ +{-# LANGUAGE GADTs #-} + +-- | A module dedicated to observability, that is reporting information about +-- what the program is doing in production to help us debugging it. +-- +-- Specifically this module is dedicated to sending information that's already +-- been collected to external monitoring platforms, such as Bugsnag and +-- Honeycomb. To learn more about how this information is collected check out the +-- `Platform.Internal` module in the `nri-prelude` package. That module also +-- defines and documents the `TracingSpan` type, which is the data structure we use to +-- contain observability data we have collected. +module Observability + ( report, + Handler, + Settings (..), + Reporter (..), + decoder, + handler, + ) +where + +import qualified Conduit +import qualified Control.Exception.Safe as Exception +import qualified Data.Aeson as Aeson +import qualified Environment +import qualified List +import qualified Platform +import qualified Reporter.Bugsnag as Bugsnag +import qualified Reporter.Dev as Dev +import qualified Reporter.File as File +import qualified Reporter.Honeycomb as Honeycomb +import qualified Set +import qualified Text +import Prelude (pure, traverse) +import qualified Prelude + +-- | A handler for reporting to logging/monitoring/observability platforms. +-- +-- The `report` function takes a span containing all the tracing information we +-- collected for a single request and then reports it to all platforms we +-- enabled when creating this handler. +newtype Handler = Handler {report :: Text -> Platform.TracingSpan -> Prelude.IO ()} + deriving (Prelude.Semigroup, Prelude.Monoid) + +-- | Function for creating an observability handler. The settings we pass in +-- determine which platforms we'll report information to. +handler :: Settings -> Conduit.Acquire Handler +handler settings = do + case enabledReporters settings of + [] -> Prelude.pure reportNothingHandler + firstReporter : otherReporters -> do + firstHandler <- toHandler reportNothingHandler settings firstReporter + otherHandlers <- traverse (toHandler firstHandler settings) otherReporters + Prelude.pure (Prelude.mconcat (firstHandler : otherHandlers)) + +reportNothingHandler :: Handler +reportNothingHandler = Handler (\_ _ -> Prelude.pure ()) + +-- | Initialize a reporter from settings, to get a handler for sending reports. +-- +-- If a reporter fails with an exception here's what we'd like to be true: +-- - It doesn't affect other reporters (they don't get aborted or anything). +-- - The reporting error gets itself reported _somewhere_ in a way that's +-- relatively likely to succeed. +toHandler :: Handler -> Settings -> Reporter -> Conduit.Acquire Handler +toHandler backup settings Reporter {reporterName, reporterSettings, reporterHandler, reporterReport} = do + handler' <- + reporterSettings settings + |> reporterHandler + |> map (Handler << reporterReport) + Prelude.pure + ( Handler + ( \requestId span -> + report handler' requestId span + -- If any error sync or async is thrown during reporting, report + -- the failure to the 'backup reporter'. + |> ( \io -> + Exception.withException + io + ( \err -> + err + |> reporterExceptionToTracingSpan reporterName span + |> report backup requestId + ) + ) + -- If this reporter fails with a sync exception we do not want it + -- to abort other reporters, so we catch those exceptions. We've + -- already tried to report on the exception above so there's + -- nothing more we could be doing with the exception anyway. + |> Exception.handleAny (\_ -> Prelude.pure ()) + ) + ) + +-- | If a reporter fails with an exception we'd like to report that exception in +-- turn to a reporter. Because reporters take spans we turn the exception into a +-- span here. +reporterExceptionToTracingSpan :: Text -> Platform.TracingSpan -> Exception.SomeException -> Platform.TracingSpan +reporterExceptionToTracingSpan reporterName originalTracingSpan exceptionDuringReporting = + Platform.emptyTracingSpan + { Platform.name = "Failed to report span to " ++ reporterName, + Platform.succeeded = Platform.FailedWith exceptionDuringReporting, + Platform.started = Platform.finished originalTracingSpan, + Platform.finished = Platform.finished originalTracingSpan, + Platform.frame = Nothing, + Platform.details = + FailedToReportTracingSpan + (Platform.name originalTracingSpan) + (Platform.details originalTracingSpan) + |> Platform.toTracingSpanDetails + |> Just, + Platform.allocated = 0, + Platform.children = [] + } + +-- | Some details about the span we were attempting to report when a reporting +-- failure happened. We're conservative with the information from the original +-- span we copy over here, in case some complexity somewhere in the original +-- span caused the report of it to fail. It's entirely likely the reporting +-- failure is unrelated to the reported span though. For example, reporting to +-- Bugsnag might fail if Bugsnag is down. +data FailedToReportTracingSpan = FailedToReportTracingSpan + { originalTracingSpanName :: Text, + originalTracingSpanDetails :: Maybe Platform.SomeTracingSpanDetails + } + deriving (Generic) + +instance Aeson.ToJSON FailedToReportTracingSpan + +instance Platform.TracingSpanDetails FailedToReportTracingSpan + +-- | A helper type that combines all the different functions a specific reporter +-- must implement in a single record. +-- +-- We've defined this as a GADT so we don't need to expose the `handler` and +-- `settings` parameters on the type, meaning this type is defined as `Reporter` +-- rather than `Reporter settings handler`. This allows us to combine multiple +-- reporters in a list. +data Reporter where + Reporter :: + { reporterName :: Text, + -- | Pick the reporter-specific settings from the global `Settings` type + -- defined in this module. + reporterSettings :: Settings -> settings, + -- | Create a handler for this reporter. This function will be called + -- once when the application starts for each enabled reporter. + reporterHandler :: settings -> Conduit.Acquire handler, + -- | Report a span to this reporter. + reporterReport :: handler -> Text -> Platform.TracingSpan -> Prelude.IO () + } -> + Reporter + +-- | A list containing all the reporters we support. Reporters are ordered in +-- increasing chance of failure, so we can pick the safest one for reporting on +-- failures in other reporters. +supportedReporters :: [Reporter] +supportedReporters = + [ Reporter "stdout" stdout fileHandler File.report, + Reporter "stdout-pretty" dev devHandler Dev.report, + Reporter "file" file fileHandler File.report, + Reporter "bugsnag" bugsnag bugsnagHandler Bugsnag.report, + Reporter "honeycomb" honeycomb honeycombHandler Honeycomb.report + ] + +fileHandler :: File.Settings -> Conduit.Acquire File.Handler +fileHandler settings = Conduit.mkAcquire (File.handler settings) File.cleanup + +devHandler :: () -> Conduit.Acquire Dev.Handler +devHandler _ = Conduit.mkAcquire Dev.handler Dev.cleanup + +bugsnagHandler :: Bugsnag.Settings -> Conduit.Acquire Bugsnag.Handler +bugsnagHandler settings = Conduit.liftIO (Bugsnag.handler settings) + +honeycombHandler :: Honeycomb.Settings -> Conduit.Acquire Honeycomb.Handler +honeycombHandler settings = Conduit.liftIO (Honeycomb.handler settings) + +-- | Settings for all supported reporters. +data Settings = Settings + { -- | The reporters that we send debugging information to. The first + -- reporter in the list is treated special: it will also report on + -- failures that take place while running any of the other reporters. + -- Because of this its best if the first reporter is one that has a + -- high likelihood of succeeding, for example because it logs to stdout + -- or a file. + enabledReporters :: [Reporter], + -- | Each supported reporter has a settings entry below. We parse + -- settings even for reporters that aren't enabled. Because our + -- environment parser insists all variables have default values it's not + -- necessary to make up values for reporters we don't want enabled. + file :: File.Settings, + bugsnag :: Bugsnag.Settings, + honeycomb :: Honeycomb.Settings, + dev :: () + } + +stdout :: Settings -> File.Settings +stdout settings = (file settings) {File.logFile = "/dev/stdout"} + +decoder :: Environment.Decoder Settings +decoder = + pure Settings + |> andMap reportersDecoder + |> andMap File.decoder + |> andMap Bugsnag.decoder + |> andMap Honeycomb.decoder + |> andMap (Prelude.pure ()) + +reportersDecoder :: Environment.Decoder [Reporter] +reportersDecoder = + Environment.variable + Environment.Variable + { Environment.name = "LOG_ENABLED_LOGGERS", + Environment.description = "Comma-separated list of logging destinations.", + Environment.defaultValue = "stdout-pretty" + } + (Environment.custom Environment.text reportersParser) + +-- Parses reporters, maintaining the same order of reporters as the +-- `supportedReporters` list. +reportersParser :: Text -> Result Text [Reporter] +reportersParser reportersString = do + names <- + reportersString + |> Text.split "," + |> traverse parseLogger + |> map Set.fromList + supportedReporters + |> List.filter (\reporter -> Set.member (reporterName reporter) names) + |> Ok + +parseLogger :: Text -> Result Text Text +parseLogger name = + let normalizedName = Text.trim (Text.toLower name) + supportedNames = + supportedReporters + |> map reporterName + |> Set.fromList + in if Set.member normalizedName supportedNames + then Ok normalizedName + else Err ("Unknown reporter: " ++ normalizedName) diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,5 +1,6 @@ module Main (main) where +import qualified Spec.Observability import qualified Spec.Platform.Timer import qualified Spec.Reporter.Bugsnag import qualified Spec.Reporter.Dev @@ -19,5 +20,6 @@ Spec.Reporter.Bugsnag.tests, Spec.Reporter.Dev.tests, Spec.Reporter.File.tests, - Spec.Reporter.Honeycomb.tests + Spec.Reporter.Honeycomb.tests, + Spec.Observability.tests ] diff --git a/tests/Spec/Observability.hs b/tests/Spec/Observability.hs new file mode 100644 --- /dev/null +++ b/tests/Spec/Observability.hs @@ -0,0 +1,111 @@ +module Spec.Observability (tests) where + +import qualified Conduit +import qualified Control.Concurrent +import qualified Control.Exception.Safe as Exception +import qualified Data.IORef as IORef +import qualified Environment +import qualified Expect +import qualified Observability +import qualified Platform +import Test (Test, describe, test) +import qualified Prelude + +tests :: Test +tests = + describe + "Observability" + [ test "When creating a handler for two reports when the handler is reporting a span both reporters are ran" <| \_ -> do + settings' <- Expect.fromIO <| Environment.decode Observability.decoder + log <- Expect.fromIO <| IORef.newIORef [] + let reporter1 = fakeReporter (\_ -> appendLog "reporter1" log) + let reporter2 = fakeReporter (\_ -> appendLog "reporter2" log) + let settings = settings' {Observability.enabledReporters = [reporter1, reporter2]} + reports <- + Expect.fromIO + ( Conduit.withAcquire (Observability.handler settings) <| \handler -> do + Observability.report handler "request-id-1234" emptyTracingSpan + IORef.readIORef log + ) + reports + |> Expect.equal ["reporter1", "reporter2"], + test "The first reporter reports sync exceptions thrown by the other reporters" <| \_ -> do + settings' <- Expect.fromIO <| Environment.decode Observability.decoder + log <- Expect.fromIO <| IORef.newIORef [] + let reporter1 = fakeReporter (\span -> appendLog ("reporter1: " ++ Platform.name span) log) + let reporter2 = fakeReporter (\_ -> Exception.throwString "failed!") + let settings = settings' {Observability.enabledReporters = [reporter1, reporter2]} + reports <- + Expect.fromIO + ( Conduit.withAcquire (Observability.handler settings) <| \handler -> do + Observability.report handler "request-id-1234" emptyTracingSpan + IORef.readIORef log + ) + reports + |> Expect.equal ["reporter1: example", "reporter1: Failed to report span to fake"], + test "The first reporter reports async exceptions thrown by the other reporters" <| \_ -> do + settings' <- Expect.fromIO <| Environment.decode Observability.decoder + log <- Expect.fromIO <| IORef.newIORef [] + let reporter1 = fakeReporter (\span -> appendLog ("reporter1: " ++ Platform.name span) log) + let reporter2 = + fakeReporter + ( \_ -> do + threadId <- Control.Concurrent.myThreadId + Exception.throwTo threadId TestException + ) + let settings = settings' {Observability.enabledReporters = [reporter1, reporter2]} + reports <- + Expect.fromIO <| Conduit.withAcquire (Observability.handler settings) <| \handler -> do + Observability.report handler "request-id-1234" emptyTracingSpan + |> Exception.handleAsync (\(Exception.AsyncExceptionWrapper _) -> Prelude.pure ()) + IORef.readIORef log + reports + |> Expect.equal ["reporter1: example", "reporter1: Failed to report span to fake"], + test "A reporter that fails with a sync exception does not prevent other reporters from completing" <| \_ -> do + settings' <- Expect.fromIO <| Environment.decode Observability.decoder + log <- Expect.fromIO <| IORef.newIORef [] + let reporter1 = fakeReporter (\span -> appendLog ("reporter1: " ++ Platform.name span) log) + let reporter2 = fakeReporter (\_ -> Exception.throwString "failed!") + let reporter3 = fakeReporter (\span -> appendLog ("reporter3: " ++ Platform.name span) log) + let settings = settings' {Observability.enabledReporters = [reporter1, reporter2, reporter3]} + reports <- + Expect.fromIO + ( Conduit.withAcquire (Observability.handler settings) <| \handler -> do + Observability.report handler "request-id-1234" emptyTracingSpan + IORef.readIORef log + ) + reports + |> Expect.equal ["reporter1: example", "reporter1: Failed to report span to fake", "reporter3: example"] + ] + +data TestException = TestException deriving (Show) + +instance Exception.Exception TestException + +appendLog :: Text -> IORef.IORef [Text] -> Prelude.IO () +appendLog line log = + IORef.atomicModifyIORef' + log + (\prev -> (prev ++ [line], ())) + +fakeReporter :: (Platform.TracingSpan -> Prelude.IO ()) -> Observability.Reporter +fakeReporter report = + Observability.Reporter + { Observability.reporterName = "fake", + Observability.reporterSettings = \_ -> (), + Observability.reporterHandler = \_ -> Prelude.pure (), + Observability.reporterReport = \_ _ span -> report span + } + +emptyTracingSpan :: Platform.TracingSpan +emptyTracingSpan = + Platform.emptyTracingSpan + { Platform.name = "example", + Platform.started = 0, + Platform.finished = 0, + Platform.frame = Nothing, + Platform.details = Nothing, + Platform.succeeded = Platform.Succeeded, + Platform.allocated = 0, + Platform.children = [] + }