hs-opentelemetry-vendor-honeycomb (empty) → 0.0.1.1

raw patch · 8 files changed

+489/−0 lines, 8 filesdep +basedep +bytestringdep +honeycomb

Dependencies added: base, bytestring, honeycomb, hs-opentelemetry-api, hs-opentelemetry-vendor-honeycomb, hspec, hspec-core, hspec-expectations, mtl, text, time, transformers, unordered-containers, uri-bytestring

Files

• ChangeLog.md +6/−0
• LICENSE +30/−0
• README.md +1/−0
• hs-opentelemetry-vendor-honeycomb.cabal +76/−0
• src/OpenTelemetry/Vendor/Honeycomb.hs +330/−0
• test/Main.hs +21/−0
• test/OpenTelemetry/Vendor/HoneycombSpec.hs +23/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,6 @@+# Changelog for hs-opentelemetry-vendor-honeycomb++## 0.0.1.0++Initial release+## Unreleased changes

@@ -0,0 +1,30 @@+Copyright (c) Mercury Technologies, Inc 2022++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.

@@ -0,0 +1,1 @@+# otlp

@@ -0,0 +1,76 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name:               hs-opentelemetry-vendor-honeycomb+version:            0.0.1.1+synopsis:           Optional OpenTelemetry integration for Honeycomb+description:        Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry#readme>+category:           OpenTelemetry+homepage:           https://github.com/iand675/hs-opentelemetry#readme+bug-reports:        https://github.com/iand675/hs-opentelemetry/issues+author:             Ian Duncan, Jade Lovelace+maintainer:         ian@iankduncan.com+copyright:          2023 Ian Duncan, Mercury Technologies+license:            BSD3+license-file:       LICENSE+build-type:         Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/iand675/hs-opentelemetry++library+  exposed-modules:+      OpenTelemetry.Vendor.Honeycomb+  other-modules:+      Paths_hs_opentelemetry_vendor_honeycomb+  hs-source-dirs:+      src+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-export-lists -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-missing-kind-signatures+  build-depends:+      base >=4.7 && <5+    , bytestring+    , honeycomb >=0.1.0.1+    , hs-opentelemetry-api+    , mtl+    , text+    , time+    , transformers+    , unordered-containers+    , uri-bytestring+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      OpenTelemetry.Vendor.HoneycombSpec+      Spec+      Paths_hs_opentelemetry_vendor_honeycomb+  hs-source-dirs:+      test+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-export-lists -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-missing-kind-signatures -threaded -rtsopts -with-rtsopts=-N -Wno-incomplete-uni-patterns -O0+  build-tool-depends:+      hspec-discover:hspec-discover+  build-depends:+      base >=4.7 && <5+    , bytestring+    , honeycomb >=0.1.0.1+    , hs-opentelemetry-api+    , hs-opentelemetry-vendor-honeycomb+    , hspec+    , hspec-core+    , hspec-expectations+    , mtl+    , text+    , time+    , transformers+    , unordered-containers+    , uri-bytestring+  default-language: Haskell2010

@@ -0,0 +1,330 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++{- | Vendor integration for Honeycomb.++   This lets you link to traces. You don't need this to send data to Honeycomb,+   for which @hs-opentelemetry-exporter-otlp@ is suitable.+-}+module OpenTelemetry.Vendor.Honeycomb (+  -- * Types+  HoneycombTeam (..),+  EnvironmentName (..),++  -- * Getting the Honeycomb target dataset/team name+  getOrInitializeHoneycombTargetInContext,+  getHoneycombTargetInContext,++  -- ** Detailed API+  getConfigPartsFromEnv,+  getHoneycombData,+  resolveHoneycombTarget,+  DatasetInfo (..),+  HoneycombTarget (..),++  -- * Making trace links+  makeDirectTraceLink,+  getHoneycombLink,+  getHoneycombLink',++  -- * Performing manual Honeycomb requests+  module Auth,+  module Config,+) where++import Control.Monad (join)+import Control.Monad.Reader (MonadIO (..), MonadTrans (..), ReaderT (runReaderT))+import Control.Monad.Trans.Maybe (MaybeT (..))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.HashMap.Strict as HM+import Data.String (IsString)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Honeycomb.API.Auth as Auth+import Honeycomb.Config as Config+import Honeycomb.Types (DatasetName (..))+import OpenTelemetry.Attributes (+  Attribute (AttributeValue),+  PrimitiveAttribute (TextAttribute),+  lookupAttribute,+ )+import qualified OpenTelemetry.Baggage as Baggage+import OpenTelemetry.Context (lookupSpan)+import qualified OpenTelemetry.Context as Context+import qualified OpenTelemetry.Context.ThreadLocal as TLContext+import OpenTelemetry.Resource (+  getMaterializedResourcesAttributes,+ )+import OpenTelemetry.Trace.Core (+  TracerProvider,+  getGlobalTracerProvider,+  getSpanContext,+  getTracerProviderResources,+  isSampled,+  traceFlags,+  traceId,+ )+import OpenTelemetry.Trace.Id (Base (..), TraceId, traceIdBaseEncodedByteString)+import System.Environment (lookupEnv)+import System.IO.Unsafe (unsafePerformIO)+import System.Timeout (timeout)+import URI.ByteString (Query (..), httpNormalization, serializeQuery')+import Prelude+++headerHoneycombApiKey :: Baggage.Token+headerHoneycombApiKey = [Baggage.token|x-honeycomb-team|]+++headerHoneycombLegacyDataset :: Baggage.Token+headerHoneycombLegacyDataset = [Baggage.token|x-honeycomb-dataset|]+++-- | Honeycomb team name; generally appears in the URL after @ui.honeycomb.io/@.+newtype HoneycombTeam = HoneycombTeam {unHoneycombTeam :: Text}+  deriving stock (Show, Eq)+  deriving newtype (IsString)+++{- | Environment name in the Environments & Services data model (referred to as+ \"Current\" in this package).++ See https://docs.honeycomb.io/honeycomb-classic/ for more details.+-}+newtype EnvironmentName = EnvironmentName {unEnvironmentName :: Text}+  deriving stock (Show, Eq)+  deriving newtype (IsString)+++{- | Gets the Honeycomb configuration from the environment.++    This does not do any HTTP.++ FIXME(jadel): This should ideally fetch this from the tracer provider, but+ it's nonobvious how to architect being able to do that (requires changes in+ hs-opentelemetry-api). For now let's take a Tracer such that we+ can fix it later, then do it the obvious way.+-}+getConfigPartsFromEnv :: (MonadIO m) => TracerProvider -> m (Maybe (Text, DatasetName))+getConfigPartsFromEnv _ = do+  mheaders <- liftIO $ lookupEnv "OTEL_EXPORTER_OTLP_HEADERS"+  pure $ getValues =<< mheaders+  where+    discardLeft (Left _) = Nothing+    discardLeft (Right a) = Just a++    getValues headers = do+      baggage <- discardLeft $ Baggage.decodeBaggageHeader (BS8.pack headers)+      token <- Baggage.value <$> (HM.lookup headerHoneycombApiKey $ Baggage.values baggage)+      let dataset = maybe "" Baggage.value (HM.lookup headerHoneycombLegacyDataset $ Baggage.values baggage)+      pure (token, DatasetName dataset)+++{- | Gets the team name and environment name for the OTLP exporter using the API+ key from the environment.++ This calls Honeycomb.++ N.B. Use 'Config.config' to construct a config from 'getConfigPartsFromEnv'.++ N.B. The EnvironmentName will be Nothing if the API key is for a Honeycomb+ Classic instance.+-}+getHoneycombData :: MonadIO m => Config.Config -> m (HoneycombTeam, Maybe EnvironmentName)+getHoneycombData cfg = do+  auth <- runReaderT Auth.getAuth cfg+  let envSlug = Auth.slug . Auth.environment $ auth+      mEnvSlug = if T.null envSlug then Nothing else Just (EnvironmentName envSlug)++      team = HoneycombTeam . Auth.slug . Auth.team $ auth+  pure (team, mEnvSlug)+++{- | Takes a 'Config.Config' and pokes around both Honeycomb HTTP API and the+ trace environment to figure out where events will land in Honeycomb.+-}+resolveHoneycombTarget :: (MonadIO m) => TracerProvider -> Config.Config -> m (Maybe HoneycombTarget)+resolveHoneycombTarget tracer cfg = do+  (team, mEnvName) <- getHoneycombData cfg+  let resources = getMaterializedResourcesAttributes . getTracerProviderResources $ tracer+  pure $+    HoneycombTarget team <$> case mEnvName of+      -- There is an env name -> Current-Honeycomb+      Just envName -> do+        AttributeValue (TextAttribute serviceName) <- lookupAttribute resources "service.name"+        pure $ Current envName (DatasetName serviceName)+      -- Honeycomb Classic+      Nothing -> do+        pure $ Classic (Config.defaultDataset cfg)+++-- | Either a current-Honeycomb environment+dataset pair, or a Honeycomb Classic dataset+data DatasetInfo+  = Current EnvironmentName DatasetName+  | Classic DatasetName+  deriving stock (Show, Eq)+++-- | A fully qualified Honeycomb dataset, possibly with environment.+data HoneycombTarget = HoneycombTarget+  { targetTeam :: HoneycombTeam+  , targetDataset :: DatasetInfo+  }+  deriving stock (Show, Eq)+++{- | Formats a direct link to a trace.++See https://docs.honeycomb.io/api/direct-trace-links/ for more details.++The URLs generated will look like the following:++Honeycomb Current:+++> https://ui.honeycomb.io/<team>/environments/<environment>/datasets/<dataset>/trace+>   ?trace_id=<traceId>+>   &trace_start_ts=<ts>+>   &trace_end_ts=<ts>++Honeycomb Classic:+++> https://ui.honeycomb.io/<team>/datasets/<dataset>/trace+>   ?trace_id=<traceId>+>   &trace_start_ts=<ts>+>   &trace_end_ts=<ts>+-}+makeDirectTraceLink :: HoneycombTarget -> UTCTime -> TraceId -> ByteString+makeDirectTraceLink HoneycombTarget {..} timestamp traceId =+  case targetDataset of+    Current env ds ->+      teamPrefix+        <> "/environments/"+        <> (encodeUtf8 . unEnvironmentName $ env)+        <> "/datasets/"+        <> (encodeUtf8 . fromDatasetName $ ds)+        <> "/trace"+        <> query+    Classic ds -> teamPrefix <> "/datasets/" <> (encodeUtf8 . fromDatasetName $ ds) <> "/trace" <> query+  where+    -- XXX(jadel): I feel like there's not really any way to know what these+    -- actual values are, even if we are omniscient of the Haskell application.+    -- For instance, if someone else calls us, we simply don't know when the+    -- trace started. So it's kind of a fool's errand. Let's just give ± 1hr and+    -- call it a day.+    oneHour = secondsToNominalDiffTime 3600+    guessedStart = addUTCTime (-oneHour) timestamp+    guessedEnd = addUTCTime oneHour timestamp+    convertTimestamp = BS8.pack . show @Integer . truncate . nominalDiffTimeToSeconds . utcTimeToPOSIXSeconds++    teamPrefix = "https://ui.honeycomb.io/" <> encodeUtf8 (unHoneycombTeam targetTeam)+    query =+      serializeQuery' httpNormalization $+        Query+          [ ("trace_id", traceIdBaseEncodedByteString Base16 traceId)+          , ("trace_start_ts", convertTimestamp guessedStart)+          , ("trace_end_ts", convertTimestamp guessedEnd)+          ]+++honeycombTargetKey :: Context.Key (Maybe HoneycombTarget)+honeycombTargetKey = unsafePerformIO $ Context.newKey "honeycombTarget"+{-# NOINLINE honeycombTargetKey #-}+++{- | Gets or initializes the Honeycomb target in the thread-local+ 'Context.Context'.++ This should be called inside the root span at application startup in order to+ ensure that this context is the parent of all child contexts in which you might+ want to get the target (for instance to generate Honeycomb links).+-}+getOrInitializeHoneycombTargetInContext ::+  MonadIO m =>+  -- | Timeout for the operation before assuming Honeycomb is inaccessible+  NominalDiffTime ->+  m (Maybe HoneycombTarget)+getOrInitializeHoneycombTargetInContext theTimeout = do+  mmTarget <- getHoneycombTargetInContext'+  case mmTarget of+    -- It was fetched before (and possibly was Nothing)+    Just t -> pure t+    -- It has not been fetched yet+    Nothing -> do+      mTarget <- join <$> liftIO (timeoutMicroseconds theTimeout getTarget)+      TLContext.adjustContext (Context.insert honeycombTargetKey mTarget)+      pure mTarget+  where+    microsecondsPerSecond = 1000 * 1000+    timeoutMicroseconds :: NominalDiffTime -> IO a -> IO (Maybe a)+    timeoutMicroseconds limit = timeout (truncate $ nominalDiffTimeToSeconds limit * microsecondsPerSecond)++    getTarget :: IO (Maybe HoneycombTarget)+    getTarget = runMaybeT $ do+      tracer <- lift getGlobalTracerProvider+      theConfig <- uncurry config <$> MaybeT (getConfigPartsFromEnv tracer)+      MaybeT $ resolveHoneycombTarget tracer theConfig+++{- | Simple function to get the Honeycomb target out of the global context.++ At application startup, run 'getOrInitializeHoneycombTargetInContext' before+ calling this, or else you will get 'Nothing'.++ This is the right function for most use cases.+-}+getHoneycombTargetInContext :: MonadIO m => m (Maybe HoneycombTarget)+getHoneycombTargetInContext = do+  join <$> getHoneycombTargetInContext'+++-- | Gets the thread-local context. The outer Maybe represents whether one has been set yet.+getHoneycombTargetInContext' :: MonadIO m => m (Maybe (Maybe HoneycombTarget))+getHoneycombTargetInContext' = do+  Context.lookup honeycombTargetKey <$> TLContext.getContext+++{- | Gets a trace link for the current trace.++ Needs to have the thread-local target initialized; see+ 'getOrInitializeHoneycombTargetInContext'.+-}+getHoneycombLink :: MonadIO m => m (Maybe ByteString)+getHoneycombLink = do+  mTarget <- getHoneycombTargetInContext+  case mTarget of+    Just target -> getHoneycombLink' target+    Nothing -> pure Nothing+++-- | Gets a trace link for the current trace with an explicitly provided target.+getHoneycombLink' :: MonadIO m => HoneycombTarget -> m (Maybe ByteString)+getHoneycombLink' target = do+  theSpan <- lookupSpan <$> TLContext.getContext+  inTraceId <- traceIdForSpan theSpan+  time <- liftIO getCurrentTime++  pure $ makeDirectTraceLink target time <$> inTraceId+  where+    traceIdForSpan = \case+      Just s -> do+        spanCtx <- getSpanContext s+        -- if not sampled, it's not useful to give a link+        pure $+          if isSampled (traceFlags spanCtx)+            then Just $ traceId spanCtx+            else Nothing+      Nothing -> pure Nothing

@@ -0,0 +1,21 @@+module Main where++import qualified Spec+import Test.Hspec+import Test.Hspec.Runner (defaultConfig, hspecWith)+import Prelude+++-- FIXME(jadel): use the hs-opentelemetry-instrumentation-hspec example+main :: IO ()+main = do+  putStrLn "Begin tests"+  runTests+++runTests :: IO ()+runTests = do+  hspecWith+    defaultConfig+    $ parallel Spec.spec+  putStrLn "Done"

@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++module OpenTelemetry.Vendor.HoneycombSpec where++import Data.Time.Calendar.OrdinalDate+import Data.Time.Clock+import OpenTelemetry.Trace.Id (bytesToTraceId)+import OpenTelemetry.Vendor.Honeycomb+import Test.Hspec+import Prelude+++spec :: Spec+spec = describe "Honeycomb vendor integration" $ do+  let team_ = HoneycombTeam "teamName"+      Right fakeTraceId = bytesToTraceId "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"+      fakeUTCTime = UTCTime (fromOrdinalDate 2022 10) 0+  it "generates valid trace links for classic" $ do+    makeDirectTraceLink (HoneycombTarget team_ (Classic "datasetName")) fakeUTCTime fakeTraceId+      `shouldBe` "https://ui.honeycomb.io/teamName/datasets/datasetName/trace?trace_id=000102030405060708090a0b0c0d0e0f&trace_start_ts=1641769200&trace_end_ts=1641776400"+  it "generates valid trace links for current" $ do+    makeDirectTraceLink (HoneycombTarget team_ (Current (EnvironmentName "environmentName") "datasetName")) fakeUTCTime fakeTraceId+      `shouldBe` "https://ui.honeycomb.io/teamName/environments/environmentName/datasets/datasetName/trace?trace_id=000102030405060708090a0b0c0d0e0f&trace_start_ts=1641769200&trace_end_ts=1641776400"

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}+