opentelemetry-plugin (empty) → 1.0.0
raw patch · 6 files changed
+581/−0 lines, 6 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, ghc, hs-opentelemetry-api, hs-opentelemetry-propagator-w3c, hs-opentelemetry-sdk, mwc-random, text, unordered-containers
Files
- CHANGELOG.md +3/−0
- LICENSE +30/−0
- README.md +66/−0
- opentelemetry-plugin.cabal +31/−0
- src/OpenTelemetry/Plugin.hs +123/−0
- src/OpenTelemetry/Plugin/Shared.hs +328/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 1.0.0++- Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2023, Mercury Technologies++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 Mercury Technologies nor the names of other+ 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+OWNER 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.
+ README.md view
@@ -0,0 +1,66 @@+# `opentelemetry-plugin` - a GHC plugin for open telemetry++This GHC plugin lets you export granular open telemetry metrics for your Haskell+builds. Specifically, this creates a trace with:++- One span for each module build+- One sub-span for each phase of each module build++++Note that due to limitations of GHC's `Plugin` interface the root span generated+by this plugin will have a duration of 0 (by default) and will not be the+correct duration (for the entire build). However, the `Plugin` will reuse any+surrounding span inherited via+[the standard `TRACEPARENT` and `TRACESTATE` environment variables](https://www.w3.org/TR/trace-context/),+so if you wrap your build in something like the `hotel` executable (from+[the `hotel-california` package](https://github.com/parsonsmatt/hotel-california))+then you will get the correct duration for the outermost span.++This plugin also supports+[the standard `BAGGAGE` environment variable](https://www.w3.org/TR/baggage/),+too.++To use this plugin:++- add the `opentelemetry-plugin` package as a build dependency of your package++- add `ghc-options: -fplugin OpenTelemetry.Plugin` to your package++- configure the appropriate open telemetry environment variables++ In other words, you'll probably want to set at least+ `OTEL_EXPORTER_OTLP_ENDPOINT` and maybe other environment variables depending+ on your open telemetry backend. For example, if you're using+ [Honeycomb](https://docs.honeycomb.io/getting-data-in/opentelemetry-overview/#using-the-honeycomb-opentelemetry-endpoint)+ then you'd also want to set `OTEL_EXPORTER_OTLP_HEADERS` and+ `OTEL_SERVICE_NAME`.++Then any time you build your project the build will export open telemetry+metrics. The overhead of metrics export is negligible.++## Development++This repository uses Nix for development. You can build this package entirely+using Nix for a specific version of `ghc` by running:++```ShellSession+$ nix develop .#ghc${MAJOR}${MINOR}+```++… replacing `${MAJOR}` and `${MINOR}` with the major and minor version of the+`ghc` that you're using. For example, if you're using GHC 9.4, then you'd run:++```ShellSession+$ nix build .#ghc94+```++If you want to develop interactively using Cabal inside of a Nix shell, run:++```ShellSession+$ nix develop .#ghc${MAJOR}${MINOR}+```++Once you are inside that Nix shell, then you can use `cabal` commands, like+`cabal build` or `cabal repl`. You can also use `ghcid` or launch your favorite+IDE from inside this shell.
+ opentelemetry-plugin.cabal view
@@ -0,0 +1,31 @@+cabal-version: 3.0+name: opentelemetry-plugin+version: 1.0.0+synopsis: GHC plugin for open telemetry+description: This package provides a GHC plugin that exports each module's build times to an open telemetry collector. See the included `README` below for more details.+license: BSD-3-Clause+license-file: LICENSE+author: Mercury Technologies+maintainer: gabriella@mercury.com+copyright: 2023 Mercury Technologies+build-type: Simple+extra-doc-files: CHANGELOG.md README.md++library+ hs-source-dirs: src+ exposed-modules: OpenTelemetry.Plugin+ build-depends: base >=4.15.0.0 && < 5+ , bytestring+ , containers+ , ghc >= 9.2 && < 9.8+ , hs-opentelemetry-api >= 0.1.0.0 && < 0.2+ , hs-opentelemetry-propagator-w3c+ , hs-opentelemetry-sdk >= 0.0.3.0 && < 0.1+ , mwc-random >= 0.13.1.0+ , text+ , unordered-containers+ other-modules: OpenTelemetry.Plugin.Shared+ , Paths_opentelemetry_plugin+ autogen-modules: Paths_opentelemetry_plugin+ default-language: Haskell2010+ ghc-options: -Wall
+ src/OpenTelemetry/Plugin.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++{-| This module provides a GHC plugin that will export open telemetry metrics+ for your build. Specifically, this plugin will create one span per module+ (recording how long that module took to build) and one sub-span per phase+ of that module's build (recording how long that phase took).+-}+module OpenTelemetry.Plugin+ ( -- * Plugin+ plugin+ ) where++import Control.Monad.IO.Class (MonadIO(..))+import GHC.Types.Target (Target(..), TargetId(..))+import OpenTelemetry.Context (Context)++import GHC.Plugins+ ( CoreToDo(..)+ , GenModule(..)+ , HscEnv(..)+ , Plugin(..)+ )+import qualified Control.Monad as Monad+import qualified Data.Text as Text+import qualified GHC.Plugins as Plugins+import qualified GHC.Utils.Outputable as Outputable+import qualified OpenTelemetry.Plugin.Shared as Shared++wrapTodo :: MonadIO io => IO Context -> CoreToDo -> io CoreToDo+wrapTodo getParentContext todo =+ case todo of+ CoreDoPasses passes ->+ fmap CoreDoPasses (traverse (wrapTodo getParentContext) passes)++ _ -> liftIO do+ let sdoc = Outputable.ppr todo++ let label =+ Outputable.showSDocOneLine Outputable.defaultSDocContext sdoc++ (_, beginPass, endPass) <- do+ Shared.makeWrapperPluginPasses False getParentContext (Text.pack label)++ let beginPluginPass =+ CoreDoPluginPass ("begin " <> label) \modGuts -> liftIO do+ beginPass++ pure modGuts++ let endPluginPass =+ CoreDoPluginPass ("end " <> label) \modGuts -> liftIO do+ endPass++ pure modGuts++ pure (CoreDoPasses [ beginPluginPass, todo, endPluginPass ])++-- | GHC plugin that exports open telemetry metrics about the build+plugin :: Plugin+plugin =+ Plugins.defaultPlugin+ { driverPlugin+ , pluginRecompile+ , installCoreToDos+ }+ where+ driverPlugin _ hscEnv@HscEnv{ hsc_targets } = do+ let rootModuleNames = do+ Target{ targetId = TargetModule rootModuleName } <- hsc_targets++ pure (Plugins.moduleNameString rootModuleName)++ Shared.setRootModuleNames rootModuleNames++ Shared.initializeTopLevelContext++ pure hscEnv++ installCoreToDos _ todos = do+ module_ <- Plugins.getModule++ let moduleName_ = moduleName module_++ let moduleText = Text.pack (Plugins.moduleNameString moduleName_)++ (getCurrentContext, firstPluginPass, lastPluginPass) <- do+ liftIO (Shared.makeWrapperPluginPasses True Shared.getTopLevelContext moduleText)++ let firstPass =+ CoreDoPluginPass "begin module" \modGuts -> liftIO do+ firstPluginPass++ pure modGuts++ let lastPass =+ CoreDoPluginPass "end module" \modGuts -> liftIO do+ lastPluginPass++ isRoot <- Shared.isRootModule (Plugins.moduleNameString moduleName_)++ -- Flush metrics if we're compiling one of the root+ -- modules. This is to work around the fact that we don't+ -- have a proper way to finalize the `TracerProvider`+ -- (since the finalizer would normally be responsible for+ -- flushing any last metrics).+ --+ -- You might wonder: why don't we end the top-level span+ -- here? Well, we don't know which one of the root modules+ -- will be the last one to be compiled. However, flushing+ -- once per root module is still fine because flushing is+ -- safe to run at any time and in practice there will only+ -- be a few root modules.+ Monad.when isRoot Shared.flush++ pure modGuts++ newTodos <- traverse (wrapTodo getCurrentContext) todos++ pure ([ firstPass ] <> newTodos <> [ lastPass ])++ pluginRecompile = Plugins.purePlugin
@@ -0,0 +1,328 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE OverloadedStrings #-}++{-| This module provides the GHC-API-agnostic logic for this plugin (mostly+ open telemetry utilities)++ Because of how GHC plugins work, this module has to do some evil stuff+ under the hood to work within the confines of the plugin API. That means+ that you should take care to use the utilities in this module correctly+ in order to avoid the plugin hanging.+-}+module OpenTelemetry.Plugin.Shared+ ( -- * Plugin passes+ makeWrapperPluginPasses++ -- * Top-level context+ , initializeTopLevelContext+ , getTopLevelContext++ -- * Root module names+ , setRootModuleNames+ , isRootModule++ -- * Flushing+ , flush++ , getSampler+ ) where++import Control.Concurrent.MVar (MVar)+import Control.Monad.IO.Class (liftIO)+import Data.ByteString (ByteString)+import Data.Set (Set)+import Data.Text (Text)+import OpenTelemetry.Context (Context)+import OpenTelemetry.Trace.Sampler (Sampler(..), SamplingResult(..))+import Prelude hiding (span)+import System.Random.MWC (GenIO)++import OpenTelemetry.Trace+ ( Attribute(..)+ , PrimitiveAttribute(..)+ , InstrumentationLibrary(..)+ , Span+ , SpanArguments(..)+ , SpanContext(..)+ , Tracer+ , TracerProvider+ , TracerProviderOptions(..)+ )++import qualified Control.Concurrent.MVar as MVar+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Set as Set+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text.Encoding+import qualified Data.Version as Version+import qualified OpenTelemetry.Context as Context+import qualified OpenTelemetry.Propagator.W3CBaggage as W3CBaggage+import qualified OpenTelemetry.Propagator.W3CTraceContext as W3CTraceContext+import qualified OpenTelemetry.Trace as Trace+import qualified OpenTelemetry.Trace.Core as Trace.Core+import qualified OpenTelemetry.Trace.Sampler as Sampler+import qualified OpenTelemetry.Trace.TraceState as TraceState+import qualified Paths_opentelemetry_plugin as Paths+import qualified System.Environment as Environment+import qualified System.IO.Unsafe as Unsafe+import qualified System.Random.MWC as MWC+import qualified Text.Read as Read++{-| Very large Haskell builds can generate an enormous number of spans,+ but none of the stock samplers provide a way to sample a subset of+ the `Span`s within a trace.++ This adds a new "spanratio" sampler which can be used to sample subset of+ module spans.+-}+getSampler :: IO (Maybe Sampler)+getSampler = do+ maybeSampler <- Environment.lookupEnv "OTEL_TRACES_SAMPLER"++ maybeRatio <- Environment.lookupEnv "OTEL_TRACES_SAMPLER_ARG"++ pure do+ "spanratio" <- maybeSampler+ ratioString <- maybeRatio+ ratio <- Read.readMaybe ratioString+ pure (spanRatioBased ratio)++{-| Like a lot of other uses of `Unsafe.unsafePerformIO` in this module, we're+ doing this because the plugin interface doesn't provide a way for us to+ acquire resources before returning the plugin.+-}+generator :: GenIO+generator = Unsafe.unsafePerformIO MWC.createSystemRandom+{-# NOINLINE generator #-}++spanRatioBased :: Double -> Sampler+spanRatioBased fraction = Sampler+ { getDescription =+ "SpanRatioBased{" <> Text.pack (show fraction) <> "}"+ , shouldSample = \context traceId_ name spanArguments -> do+ case HashMap.lookup "sample" (attributes spanArguments) of+ Just (AttributeValue (BoolAttribute True)) -> do+ random <- MWC.uniformR (0, 1) generator++ let samplingResult =+ if random < fraction then RecordAndSample else Drop++ traceState_ <- case Context.lookupSpan context of+ Nothing ->+ pure TraceState.empty++ Just span ->+ fmap traceState (Trace.Core.getSpanContext span)++ pure (samplingResult, HashMap.empty, traceState_)++ _ ->+ shouldSample Sampler.alwaysOn context traceId_ name spanArguments+ }++{-| Note: We don't properly shut this down using `Trace.shutdownTracerProvider`,+ but all that the shutdown does is flush metrics, so instead we flush metrics+ (using `flush`) at the end of compilation to make up for the lack of a+ proper shutdown.+-}+tracerProvider :: TracerProvider+tracerProvider = Unsafe.unsafePerformIO do+ (processors, options) <- Trace.getTracerProviderInitializationOptions++ maybeSampler <- getSampler++ let newOptions =+ case maybeSampler of+ Nothing -> options+ Just sampler -> options{ tracerProviderOptionsSampler = sampler }++ tracerProvider_ <- Trace.createTracerProvider processors newOptions++ Trace.setGlobalTracerProvider tracerProvider_++ pure tracerProvider_+{-# NOINLINE tracerProvider #-}++tracer :: Tracer+tracer =+ Trace.makeTracer tracerProvider instrumentationLibrary Trace.tracerOptions+ where+ instrumentationLibrary =+ InstrumentationLibrary+ { libraryName = "opentelemetry-plugin"+ , libraryVersion = Text.pack (Version.showVersion Paths.version)+ }++{-| This used by the GHC plugin to create two plugin passes that start and stop+ a `Span`, respectively.++ In order for `Span` ancestry to be tracked correctly this takes an+ @`IO` `Context`@ as an input (to read the parent `Span`'s `Context`) and+ returns an @`IO` `Context`@ as an output (to read the current `Span`'s+ `Context`).+-}+makeWrapperPluginPasses+ :: Bool+ -- ^ Whether to sample a subset of spans+ -> IO Context+ -- ^ Action to ead the parent span's `Context`+ -> Text+ -- ^ Label for the current span+ -> IO (IO Context, IO (), IO ())+makeWrapperPluginPasses sample getParentContext label = liftIO do+ spanMVar <- liftIO MVar.newEmptyMVar+ currentContextMVar <- liftIO MVar.newEmptyMVar++ let beginPass = do+ parentContext <- getParentContext++ let spanArguments =+ if sample+ then+ Trace.defaultSpanArguments+ { attributes =+ HashMap.singleton "sample" (AttributeValue (BoolAttribute True))+ }+ else+ Trace.defaultSpanArguments++ passSpan <- Trace.createSpan tracer parentContext label spanArguments++ _ <- MVar.tryPutMVar spanMVar passSpan++ let currentContext = Context.insertSpan passSpan parentContext++ _ <- MVar.tryPutMVar currentContextMVar currentContext++ pure ()++ let endPass = do+ passSpan <- MVar.readMVar spanMVar++ Trace.endSpan passSpan Nothing++ pure (MVar.readMVar currentContextMVar, beginPass, endPass)++{-| We're intentionally **NOT** using `OpenTelemetry.Context.ThreadLocal`+ here since the `GHC.Plugins.Plugin` logic doesn't necessarily run in a+ single thread (@ghc@ builds can be multi-threaded). Instead, we provide+ our own `Context` global variable.+-}+topLevelContextMVar :: MVar Context+topLevelContextMVar = Unsafe.unsafePerformIO MVar.newEmptyMVar+{-# NOINLINE topLevelContextMVar #-}++getTopLevelSpan :: IO Span+getTopLevelSpan = do+ traceParent <- lookupEnv "TRACEPARENT"+ traceState_ <- lookupEnv "TRACESTATE"++ case W3CTraceContext.decodeSpanContext traceParent traceState_ of+ Just spanContext ->+ pure (Trace.Core.wrapSpanContext spanContext)++ Nothing -> do+ -- If we're not inheriting a span from+ -- `TRACEPARENT`/`TRACESTATE`, then create a zero-duration span+ -- whose sole purpose is to be a parent span for each module's+ -- spans.+ --+ -- Ideally we'd like this span's duration to last for the+ -- entirety of compilation, but there isn't a good way to end+ -- the span when compilation is done. Also, we still need+ -- *some* parent span for each module's spans, otherwise an+ -- entirely new trace will be created for each new span.+ -- Creating a zero-duration span is the least-worst solution.+ --+ -- Note that there aren't any issues with the child spans+ -- lasting longer than the parent span. This is supported by+ -- open telemetry and the Haskell API.+ timestamp <- Trace.Core.getTimestamp++ let arguments =+ Trace.defaultSpanArguments+ { startTime = Just timestamp }++ span <- Trace.createSpan tracer Context.empty "opentelemetry GHC plugin" arguments++ Trace.endSpan span (Just timestamp)++ pure span++getTopLevelBaggage :: IO Context+getTopLevelBaggage = do+ maybeBytes <- lookupEnv "BAGGAGE"+ case maybeBytes >>= W3CBaggage.decodeBaggage of+ Nothing -> pure Context.empty+ Just baggage -> pure (Context.insertBaggage baggage Context.empty)++lookupEnv :: String -> IO (Maybe ByteString)+lookupEnv = fmap (fmap (fmap encode)) Environment.lookupEnv+ where+ encode = Text.Encoding.encodeUtf8 . Text.pack++{-| This initializes the top-level `Context` using the @TRACEPARENT@ \/+ @TRACESTATE@ \/ @BAGGAGE@ environment variables (if present) and otherwise+ sets it to the empty `Context`++ You have to run this command before calling `getTopLevelContext` otherwise+ the latter will hang.+-}+initializeTopLevelContext :: IO ()+initializeTopLevelContext = do+ span <- getTopLevelSpan++ context <- getTopLevelBaggage++ let contextWithSpan = Context.insertSpan span context++ _ <- MVar.tryPutMVar topLevelContextMVar contextWithSpan++ return ()++-- | Access the top-level `Context` computed by `initializeTopLevelContext`+getTopLevelContext :: IO Context+getTopLevelContext = MVar.readMVar topLevelContextMVar++{-| This is used for communicating between `GHC.Plugins.driverPlugin` and+ `GHC.Plugins.installCoreToDos`, because only `GHC.Plugins.driverPlugin` has+ access to the full module graph, but there isn't a good way within the+ `GHC.Plugins.Plugin` API to share that information with the rest of the+ plugin other than a global variable.+-}+rootModuleNamesMVar :: MVar (Set Text)+rootModuleNamesMVar = Unsafe.unsafePerformIO MVar.newEmptyMVar+{-# NOINLINE rootModuleNamesMVar #-}++{-| Set the root module names (computed by `GHC.Plugins.driverPlugin`)++ You have to run this command before calling `isRootModule` otherwise+ the latter will hang.+-}+setRootModuleNames :: [String] -> IO ()+setRootModuleNames rootModuleNames = do+ let set = Set.fromList (map Text.pack rootModuleNames)++ _ <- MVar.tryPutMVar rootModuleNamesMVar set++ pure ()++-- | Check if a module is one of the root modules+isRootModule :: String -> IO Bool+isRootModule moduleName = do+ rootModuleNames <- MVar.readMVar rootModuleNamesMVar++ pure (Set.member (Text.pack moduleName) rootModuleNames)++-- | Flush all metrics+flush :: IO ()+flush = do+ _ <- Trace.Core.forceFlushTracerProvider tracerProvider Nothing+ -- We can't check the result yet because+ -- `FlushResult` is not exported by+ -- `hs-opentelemetry-api`+ --+ -- https://github.com/iand675/hs-opentelemetry/pull/96+ _ <- Trace.Core.forceFlushTracerProvider tracerProvider Nothing++ pure ()