diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 0.1.1.2 + +- Support `aeson-2.0.x`. + # 0.1.1.1 - Add `Observability` glue module (still needs better documentation!) 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.1 +version: 0.1.1.2 synopsis: Report log spans collected by nri-prelude. description: Please see the README at . category: Web @@ -39,6 +39,7 @@ Reporter.Honeycomb Observability other-modules: + Platform.AesonHelpers Platform.ReporterHelpers Platform.Timer Reporter.Bugsnag.Internal @@ -64,7 +65,7 @@ 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 >=1.4.6.0 && <2.1 , aeson-pretty >=0.8.0 && <0.9 , async >=2.2.2 && <2.3 , base >=4.12.0.0 && <4.16 @@ -101,6 +102,7 @@ Log.RedisCommands Log.SqlQuery Observability + Platform.AesonHelpers Platform.ReporterHelpers Platform.Timer Reporter.Bugsnag @@ -132,7 +134,7 @@ 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 >=1.4.6.0 && <2.1 , aeson-pretty >=0.8.0 && <0.9 , async >=2.2.2 && <2.3 , base >=4.12.0.0 && <4.16 diff --git a/src/Observability.hs b/src/Observability.hs --- a/src/Observability.hs +++ b/src/Observability.hs @@ -35,11 +35,12 @@ 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 ()} +newtype Handler = Handler + { -- | `report` 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. + report :: Text -> Platform.TracingSpan -> Prelude.IO () + } deriving (Prelude.Semigroup, Prelude.Monoid) -- | Function for creating an observability handler. The settings we pass in @@ -195,6 +196,8 @@ stdout :: Settings -> File.Settings stdout settings = (file settings) {File.logFile = "/dev/stdout"} +-- | 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 = pure Settings diff --git a/src/Platform/AesonHelpers.hs b/src/Platform/AesonHelpers.hs new file mode 100644 --- /dev/null +++ b/src/Platform/AesonHelpers.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE CPP #-} + +-- | This module supports working with aeson objects in a way compatible with +-- both the 1.x and 2.x versions of the aseon library. +-- +-- Aeson has a Value type for representing JSON values. The Value type has +-- constructors for JSON strings, numbers, arrays, and objects. Aeson represents +-- JSON objects using an Object type, which in versions 1.x of aeson is a type +-- alias for a HashMap. Version 2.x of library make Object an opaque type. +-- +-- nri-observability needs to perform some operations on JSON objects. Depending +-- on which version of aeson we got, we need to use different functions to +-- perform these operations. This module contains implementations for both 1.x +-- and 2.x versions of Aeson, and automatically picks the right version +-- depending on which version of the library is detected. +-- +-- Once we're done supporting versions 1.x of aeson we can drop this module and +-- inline the 2.x versions of functions wherever they are called. +module Platform.AesonHelpers (foldObject, mergeObjects) where + +#if MIN_VERSION_aeson(2,0,0) + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap + +foldObject :: (Text -> Aeson.Value -> acc -> acc) -> acc -> Aeson.Object -> acc +foldObject fn = KeyMap.foldrWithKey (\key val acc -> fn (Key.toText key) val acc) + +mergeObjects :: + (Aeson.Value -> Aeson.Value -> Aeson.Value) -> + Aeson.Object -> + Aeson.Object -> + Aeson.Object +mergeObjects = KeyMap.unionWith + +#else + +import qualified Data.Aeson as Aeson +import qualified Data.HashMap.Strict as HashMap + +foldObject :: (Text -> Aeson.Value -> acc -> acc) -> acc -> Aeson.Object -> acc +foldObject = HashMap.foldrWithKey + +mergeObjects :: + (Aeson.Value -> Aeson.Value -> Aeson.Value) -> + Aeson.Object -> + Aeson.Object -> + Aeson.Object +mergeObjects merge object1 object2 = HashMap.unionWith merge object1 object2 + +#endif diff --git a/src/Platform/ReporterHelpers.hs b/src/Platform/ReporterHelpers.hs --- a/src/Platform/ReporterHelpers.hs +++ b/src/Platform/ReporterHelpers.hs @@ -5,6 +5,7 @@ import qualified Data.HashMap.Strict as HashMap import qualified GHC.Stack as Stack import qualified List +import qualified Platform.AesonHelpers as AesonHelpers import qualified Text import qualified Prelude @@ -30,19 +31,19 @@ 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) + Aeson.Object object -> + AesonHelpers.foldObject + (\key value acc -> jsonAsText key value ++ acc) HashMap.empty - dict + object 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) + AesonHelpers.foldObject + (\key2 value acc -> jsonAsText (key ++ "." ++ key2) value ++ acc) HashMap.empty dict Aeson.Array vals -> diff --git a/src/Reporter/Bugsnag/Internal.hs b/src/Reporter/Bugsnag/Internal.hs --- a/src/Reporter/Bugsnag/Internal.hs +++ b/src/Reporter/Bugsnag/Internal.hs @@ -24,6 +24,7 @@ import qualified Network.HTTP.Client.TLS as HTTP.TLS import qualified Network.HostName import qualified Platform +import qualified Platform.AesonHelpers as AesonHelpers import qualified Platform.ReporterHelpers as Helpers import qualified Platform.Timer as Timer import qualified Prelude @@ -380,7 +381,7 @@ } mergeJson :: Aeson.Value -> Aeson.Value -> Aeson.Value -mergeJson (Aeson.Object x) (Aeson.Object y) = Aeson.Object (HashMap.unionWith mergeJson x y) +mergeJson (Aeson.Object x) (Aeson.Object y) = Aeson.Object (AesonHelpers.mergeObjects mergeJson x y) mergeJson _ last = last mergeMetaData :: diff --git a/src/Reporter/Honeycomb.hs b/src/Reporter/Honeycomb.hs --- a/src/Reporter/Honeycomb.hs +++ b/src/Reporter/Honeycomb.hs @@ -3,7 +3,7 @@ ( Internal.report, Internal.handler, Internal.Handler, - Internal.Settings(..), + Internal.Settings (..), Internal.decoder, ) where diff --git a/src/Reporter/Honeycomb/Internal.hs b/src/Reporter/Honeycomb/Internal.hs --- a/src/Reporter/Honeycomb/Internal.hs +++ b/src/Reporter/Honeycomb/Internal.hs @@ -5,7 +5,6 @@ import qualified Control.Exception.Safe as Exception import qualified Data.Aeson as Aeson import qualified Data.ByteString as ByteString -import qualified Data.HashMap.Strict as HashMap import qualified Data.List import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Text.Encoding as Encoding @@ -27,6 +26,7 @@ import qualified Network.HTTP.Client.TLS as HTTP.TLS import qualified Network.HostName import qualified Platform +import qualified Platform.AesonHelpers as AesonHelpers import qualified Platform.Timer as Timer import qualified System.Random as Random import qualified Text @@ -99,13 +99,15 @@ -- healthcheck endpoints don't populate `HttpRequest.endpoint`. -- Fix that first before trying this. Just requestPath -> List.any (requestPath ==) ["/health/readiness", "/metrics", "/health/liveness"] - baseRate = fractionOfSuccessRequestsLogged settings + baseRate = modifyFractionOfSuccessRequestsLogged settings (fractionOfSuccessRequestsLogged settings) rootSpan requestDurationMs = Timer.difference (Platform.started rootSpan) (Platform.finished rootSpan) |> Platform.inMicroseconds |> Prelude.fromIntegral |> (*) 1e-3 - apdexTMs = Prelude.fromIntegral (apdexTimeMs settings) + apdexTMs = + modifyApdexTimeMs settings (apdexTimeMs settings) rootSpan + |> Prelude.fromIntegral in if isNonAppRequestPath then -- -- We have 2678400 seconds in a month @@ -332,11 +334,11 @@ renderDetailsGeneric :: Text -> Platform.SomeTracingSpanDetails -> Span -> Span renderDetailsGeneric keyPrefix details honeycombSpan = case Aeson.toJSON details of - Aeson.Object hashMap -> - HashMap.foldrWithKey + Aeson.Object object -> + AesonHelpers.foldObject (\key value -> addField (useAsKey (keyPrefix ++ "." ++ key)) value) honeycombSpan - hashMap + object jsonVal -> addField keyPrefix jsonVal honeycombSpan -- LogContext is an unbounded list of key value pairs with possibly nested @@ -571,7 +573,19 @@ -- -- [@environment variable@] HONEYCOMB_APDEX_TIME_IN_MILLISECONDS -- [@default value@] 100 - apdexTimeMs :: Int + apdexTimeMs :: Int, + -- | Allows overriding the default sample rates for given spans. + -- This allows us to change the sample rate for certain endpoints within an + -- application, for example if a path is critical but low volume we may choose + -- to increase the rate. + -- [@default value@] the input float + modifyFractionOfSuccessRequestsLogged :: Float -> Platform.TracingSpan -> Float, + -- | Allows overriding the default apdex rates for given spans. + -- This allows us to change the apdex for certain endpoints within an + -- application, for example if a path is significantly lower volume than + -- another the apdex may require tuning. + -- [@default value@] the input int + modifyApdexTimeMs :: Int -> Platform.TracingSpan -> Int } -- | Read 'Settings' from environment variables. Default variables will be used @@ -584,6 +598,8 @@ |> andMap honeycombAppNameDecoder |> andMap fractionOfSuccessRequestsLoggedDecoder |> andMap apdexTimeMsDecoder + |> andMap (Prelude.pure always) + |> andMap (Prelude.pure always) honeycombApiKeyDecoder :: Environment.Decoder (Log.Secret ByteString.ByteString) honeycombApiKeyDecoder = diff --git a/tests/Spec/Reporter/Honeycomb.hs b/tests/Spec/Reporter/Honeycomb.hs --- a/tests/Spec/Reporter/Honeycomb.hs +++ b/tests/Spec/Reporter/Honeycomb.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NumericUnderscores #-} + module Spec.Reporter.Honeycomb (tests) where import qualified Control.Exception.Safe as Exception @@ -20,6 +22,7 @@ import qualified Platform.Timer as Timer import qualified Reporter.Honeycomb.Internal as Honeycomb import Test (Test, describe, test) +import qualified Prelude tests :: Test tests = @@ -315,6 +318,52 @@ |> (:) ("apdex T: " ++ Text.fromFloat apdexTMs ++ "ms") |> Text.join "\n" |> Expect.equalToContentsOf "test/golden-results/observability-spec-honeycomb-sampling" + ], + describe + "deriveSampleRate" + [ test "modifies configured sample rate by route" <| \_ -> do + let matchingSpan = + emptyTracingSpan + { Platform.name = "matching-span" + } + let customRate = 1.0 + let defaultRate = 0.1 + let settings = + emptySettings + { Honeycomb.fractionOfSuccessRequestsLogged = defaultRate, + Honeycomb.modifyFractionOfSuccessRequestsLogged = + \rate span -> + case Platform.name span of + "matching-span" -> customRate + _ -> rate + } + Honeycomb.deriveSampleRate matchingSpan settings + |> Expect.within (Expect.Absolute 0.001) customRate + + Honeycomb.deriveSampleRate emptyTracingSpan settings + |> Expect.within (Expect.Absolute 0.001) defaultRate, + test "modifies configured apdex by route" <| \_ -> do + let matchingSpan = + emptyTracingSpan + { Platform.name = "matching-span", + Platform.started = 0, + Platform.finished = 1000 + } + let settings = + emptySettings + { Honeycomb.fractionOfSuccessRequestsLogged = 0.1, + Honeycomb.apdexTimeMs = Prelude.maxBound, + Honeycomb.modifyApdexTimeMs = + \defaultApdex span -> + case Platform.name span of + "matching-span" -> 10 + _ -> defaultApdex + } + Honeycomb.deriveSampleRate matchingSpan settings + |> Expect.notWithin (Expect.Absolute 0.001) 0.1 + + Honeycomb.deriveSampleRate emptyTracingSpan settings + |> Expect.within (Expect.Absolute 0.001) 0.1 ] ] @@ -341,6 +390,18 @@ Platform.succeeded = Platform.Succeeded, Platform.allocated = 0, Platform.children = [] + } + +emptySettings :: Honeycomb.Settings +emptySettings = + Honeycomb.Settings + { Honeycomb.apiKey = Log.mkSecret "api-key", + Honeycomb.datasetName = "dataset", + Honeycomb.serviceName = "service", + Honeycomb.fractionOfSuccessRequestsLogged = 0.0, + Honeycomb.apdexTimeMs = 10, + Honeycomb.modifyFractionOfSuccessRequestsLogged = always, + Honeycomb.modifyApdexTimeMs = always } toBatchEvents :: Platform.TracingSpan -> [Honeycomb.BatchEvent]