opentelemetry-lightstep 0.2.0 → 0.3.0

raw patch · 9 files changed

+140/−323 lines, 9 filesdep +clockdep +containersdep +filepathdep ~basedep ~opentelemetrynew-component:exe:eventlog-to-lightstepPVP ok

version bump matches the API change (PVP)

Dependencies added: clock, containers, filepath, ghc-events, opentelemetry-extra, splitmix

Dependency ranges changed: base, opentelemetry

API changes (from Hackage documentation)

Files

• exe/eventlog-to-lightstep/Main.hs +30/−0
• just-some-usage-code-that-must-compile/Main.hs +0/−2
• just-some-usage-code-that-must-compile/SomeUsageOfImplicitApi.hs +0/−56
• opentelemetry-lightstep.cabal +29/−16
• src/OpenTelemetry/LightStep.hs +0/−21
• src/OpenTelemetry/LightStep/Config.hs +0/−47
• src/OpenTelemetry/LightStep/ZipkinExporter.hs +0/−181
• src/OpenTelemetry/Lightstep/Config.hs +46/−0
• src/OpenTelemetry/Lightstep/Exporter.hs +35/−0

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.Text as T+import OpenTelemetry.EventlogStreaming_Internal+import OpenTelemetry.Exporter+import OpenTelemetry.Lightstep.Config+import OpenTelemetry.Lightstep.Exporter+import System.Clock+import System.Environment (getArgs)+import System.FilePath+import System.IO+import Text.Printf++main :: IO ()+main = do+  args <- getArgs+  case args of+    ["read", path] -> do+      printf "Sending %s to Lightstep...\n" path+      Just lsConfig <- getEnvConfig+      let service_name = T.pack $ takeBaseName path+      exporter <- createLightstepSpanExporter lsConfig {lsServiceName = service_name}+      origin_timestamp <- fromIntegral . toNanoSecs <$> getTime Realtime+      withFile path ReadMode (work origin_timestamp exporter)+      shutdown exporter+      putStrLn "\nAll done.\n"+    _ -> do+      putStrLn "Usage:"+      putStrLn ""+      putStrLn "  eventlog-to-lightstep read <program.eventlog>"

@@ -1,2 +0,0 @@-main :: IO ()-main = putStrLn "All done"

@@ -1,56 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module SomeUsageOfImplicitApi where--import Control.Concurrent-import Control.Concurrent.Async-import Control.Monad-import OpenTelemetry.Common-import OpenTelemetry.FileExporter-import OpenTelemetry.Implicit--main :: IO ()-main = do-  exporter <- createFileSpanExporter "helloworld.trace"-  let otConfig =-        OpenTelemetryConfig-          { otcSpanExporter = exporter-          }-  withOpenTelemetry otConfig $ do-    result <- pieceOfSeriousBusinessLogic 42-    print result--pieceOfSeriousBusinessLogic :: Int -> IO Int-pieceOfSeriousBusinessLogic input = withSpan "serious business" $ do-  let result = 2 * input-  -- setTag is value-polymorphic--  -- setTag "input" input -- Int (inferred)-  -- setTag @Int "result" result -- Int (explicit)-  -- setTag @String "seriousness" "serious" -- literals are polymorphic under OverloadedStrings so we need to annotate-  -- setTag @Double "profit" 99 -- numeric literals are also polymorphic-  -- setTag "error" False -- Bool literals are not polymorphic-  -- setTag @Int "largest integer below 100" 99 -- Int (inferred)--  -- TODO: JSON values--  addEvent "log" "rpc roundtrip begin"-  withSpan "leveraging synergies" $ do-    threadDelay 10000-    addEvent "log" "enough synergies leveraged"-  addEvent "log" "All your base are belong to us"-  addEvent "log" "rpc roundtrip end"-  withSpan "project" $ do-    -- Connecting spans across threads requires some manual plumbing-    Just sp <- getCurrentActiveSpan-    asyncWork <- async $ withChildSpanOf sp "data science" $ do-      threadDelay 1000000-      pure (42 :: Int)-    -- Doing a withSpan inside a loop is fine-    forM_ [input .. input + 10] $ \i -> withSpan "sprint" $ do-      -- setTag "week" i-      threadDelay (10000 + i)-    _ <- wait asyncWork-    pure ()-  pure result

@@ -1,8 +1,8 @@ cabal-version:       2.4 name:                opentelemetry-lightstep-description:         The OpenTelemetry Haskell Client (LightStep exporter) https://opentelemetry.io+description:         The OpenTelemetry Haskell Client (Lightstep exporter) https://opentelemetry.io category:            OpenTelemetry-version:             0.2.0+version: 0.3.0 license-file:        LICENSE license:             Apache-2.0 author:              Dmitry Ivanov@@ -37,7 +37,6 @@     -Wincomplete-record-updates     -Wincomplete-uni-patterns     -Wpartial-fields-    -Wredundant-constraints     -fhide-source-paths     -ferror-spans     -freverse-errors@@ -54,26 +53,40 @@     http-client-tls,     http-types,     network,-    opentelemetry,+    opentelemetry >= 0.3.0,+    opentelemetry-extra,     scientific,     stm,     text,     unordered-containers   hs-source-dirs: src   exposed-modules:-    OpenTelemetry.LightStep-    OpenTelemetry.LightStep.Config-    OpenTelemetry.LightStep.ZipkinExporter+    OpenTelemetry.Lightstep.Config+    OpenTelemetry.Lightstep.Exporter -test-suite just-some-usage-code-that-must-compile+executable eventlog-to-lightstep   import: options-  type:       exitcode-stdio-1.0-  main-is:    Main.hs-  other-modules:-    SomeUsageOfImplicitApi-  hs-source-dirs: just-some-usage-code-that-must-compile+  ghc-options:+    -threaded+    -rtsopts+    -eventlog   build-depends:-    base,+    base >= 4.12 && < 5,     async,-    opentelemetry,-    opentelemetry-lightstep+    bytestring,+    clock,+    containers,+    exceptions,+    filepath,+    ghc-events >= 0.13.0,+    http-client,+    http-types,+    opentelemetry >= 0.3.0,+    opentelemetry-extra,+    opentelemetry-lightstep,+    splitmix,+    text,+    unordered-containers+  main-is: Main.hs+  hs-source-dirs: exe/eventlog-to-lightstep+

@@ -1,21 +0,0 @@-module OpenTelemetry.LightStep where--import Control.Monad.Catch-import Control.Monad.IO.Class-import OpenTelemetry.Common-import OpenTelemetry.Implicit-import OpenTelemetry.LightStep.Config-import OpenTelemetry.LightStep.ZipkinExporter-import System.IO--withEnvConfigLightStepOpenTelemetry :: (MonadIO m, MonadMask m) => m a -> m a-withEnvConfigLightStepOpenTelemetry action = do-  mcfg <- getEnvConfig-  case mcfg of-    Just cfg -> do-      exporter <- createLightStepSpanExporter cfg-      let otelConfig = OpenTelemetryConfig {otcSpanExporter = exporter}-      withOpenTelemetry otelConfig action-    Nothing -> do-      liftIO $ hPutStrLn stderr "Warning: LightStep exporter is not configured"-      action

@@ -1,47 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module OpenTelemetry.LightStep.Config where--import Control.Monad.IO.Class-import Data.Foldable-import Data.Maybe-import qualified Data.Text as T-import Network.Socket-import System.Environment-import System.IO--data LightStepConfig-  = LightStepConfig-      { lsHostName :: HostName,-        lsPort :: PortNumber,-        lsToken :: T.Text,-        lsServiceName :: T.Text,-        lsGlobalTags :: [(T.Text, T.Text)],-        lsGracefulShutdownTimeoutSeconds :: Word,-        lsSpanQueueSize :: Word-      }--lookupOneOfEnvs :: [String] -> IO (Maybe String)-lookupOneOfEnvs names = asum <$> traverse lookupEnv names--getEnvTagsWithPrefix :: T.Text -> IO [(T.Text, T.Text)]-getEnvTagsWithPrefix prefix =-  mapMaybe unprefix <$> getEnvironment-  where-    unprefix ((T.stripPrefix prefix . T.pack) -> Just k, v) = Just (k, T.pack v)-    unprefix _ = Nothing--getEnvConfig :: MonadIO m => m (Maybe LightStepConfig)-getEnvConfig = liftIO $ do-  prog_name <- getProgName-  maybe_token_from_env <- lookupOneOfEnvs ["LIGHTSTEP_TOKEN", "LIGHTSTEP_ACCESS_TOKEN", "OPENTRACING_LIGHTSTEP_ACCESS_TOKEN"]-  global_tags <- getEnvTagsWithPrefix "OPENTRACING_TAG_"-  case maybe_token_from_env of-    Just t -> do-      host <- fromMaybe "ingest.lightstep.com" <$> lookupOneOfEnvs ["LIGHTSTEP_HOST", "OPENTRACING_LIGHTSTEP_COLLECTOR_HOST"]-      port <- maybe 443 read <$> lookupOneOfEnvs ["LIGHTSTEP_PORT", "OPENTRACING_LIGHTSTEP_COLLECTOR_PORT"]-      service <- fromMaybe prog_name <$> lookupOneOfEnvs ["LIGHTSTEP_SERVICE", "OPENTRACING_LIGHTSTEP_COMPONENT_NAME"]-      pure $ Just $ LightStepConfig host port (T.pack t) (T.pack service) global_tags 5 4096-    Nothing -> do-      hPutStrLn stderr "LIGHTSTEP_ACCESS_TOKEN environment variable not defined"-      pure Nothing

@@ -1,181 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module OpenTelemetry.LightStep.ZipkinExporter where---- Zipkin V2 protocol spec: https://github.com/openzipkin/zipkin-api/blob/master/zipkin2-api.yaml--import Control.Concurrent.Async-import Control.Concurrent.STM-import Control.Monad.IO.Class-import Data.Aeson-import qualified Data.HashMap.Strict as HM-import Data.Scientific-import qualified Data.Text as T-import Network.HTTP.Client-import Network.HTTP.Client.TLS-import Network.HTTP.Types-import OpenTelemetry.Common-import OpenTelemetry.Debug-import OpenTelemetry.LightStep.Config-import System.IO.Unsafe-import Text.Printf--data ZipkinSpan-  = ZipkinSpan-      { zsConfig :: LightStepConfig,-        zsSpan :: Span-      }--tagValue2text :: TagValue -> T.Text-tagValue2text tv = case tv of-  (StringTagValue s) -> s-  (BoolTagValue b) -> if b then "true" else "false"-  (IntTagValue i) -> T.pack $ show i-  (DoubleTagValue d) -> T.pack $ show (fromFloatDigits d)--instance ToJSON ZipkinSpan where--  -- FIXME(divanov): deduplicate-  toJSON (ZipkinSpan LightStepConfig {..} s@(Span {..})) =-    let TId tid = spanTraceId s-        SId sid = spanId s-        ts = spanStartedAt `div` 1000-        duration = (spanFinishedAt - spanStartedAt) `div` 1000-     in object $-          [ "name" .= spanOperation,-            "traceId" .= T.pack (printf "%016x" tid),-            "id" .= T.pack (printf "%016x" sid),-            "timestamp" .= ts,-            "duration" .= duration,-            "tags"-              .= object-                ( [ "lightstep.access_token" .= lsToken,-                    "lightstep.component_name" .= lsServiceName-                  ]-                    <> [k .= v | (k, v) <- lsGlobalTags]-                    <> [k .= tagValue2text v | (k, v) <- HM.toList spanTags]-                ),-            "annotations"-              .= [ object ["timestamp" .= (t `div` 1000), "value" .= v]-                   | SpanEvent t _ v <- spanEvents-                 ]-          ]-            <> (maybe [] (\(SId psid) -> ["parentId" .= psid]) spanParentId)--  toEncoding (ZipkinSpan LightStepConfig {..} s@(Span {..})) =-    let TId tid = spanTraceId s-        SId sid = spanId s-        ts = spanStartedAt `div` 1000-        duration = (spanFinishedAt - spanStartedAt) `div` 1000-     in pairs-          ( "name" .= spanOperation-              <> "traceId" .= T.pack (printf "%016x" tid)-              <> "id" .= T.pack (printf "%016x" sid)-              <> "timestamp" .= ts-              <> "duration" .= duration-              <> "tags"-                .= object-                  ( [ "lightstep.access_token" .= lsToken,-                      "lightstep.component_name" .= lsServiceName-                    ]-                      <> [k .= v | (k, v) <- lsGlobalTags]-                      <> [k .= tagValue2text v | (k, v) <- HM.toList spanTags]-                  )-              <> ( maybe-                     mempty-                     (\(SId psid) -> "parentId" .= T.pack (printf "%016x" psid))-                     spanParentId-                 )-              <> "annotations"-                .= [ object ["timestamp" .= (t `div` 1000), "value" .= v]-                     | SpanEvent t _ v <- spanEvents-                   ]-          )--data LightStepClient-  = LightStepClient-      { lscConfig :: LightStepConfig,-        lscSenderThread :: Async (),-        lscSenderQueue :: TBQueue Span,-        lscShutdownVar :: TVar Bool-      }--createLightStepSpanExporter :: MonadIO m => LightStepConfig -> m (Exporter Span)-createLightStepSpanExporter cfg = liftIO do-  client <- mkClient cfg-  pure-    $! Exporter-      ( \sps -> do-          let q = lscSenderQueue client-          atomically $ do-            q_population <- fromIntegral <$> lengthTBQueue q-            let q_vacancy = fromIntegral (lsSpanQueueSize (lscConfig client) - q_population)-            modifyTVar droppedSpanCountVar (\x -> x + length sps - q_vacancy)-            mapM_-              (writeTBQueue q)-              (take q_vacancy sps)-          pure ExportSuccess-      )-      ( do-          atomically $-            writeTVar (lscShutdownVar client) True-          wait (lscSenderThread client)-      )--mkClient :: LightStepConfig -> IO LightStepClient-mkClient cfg@(LightStepConfig {..}) = do-  let endpoint = printf "https://%s:%d/api/v2/spans" lsHostName (fromIntegral lsPort :: Int)-  manager <- newManager tlsManagerSettings-  q <- newTBQueueIO (fromIntegral lsSpanQueueSize)-  shutdown_var <- newTVarIO False-  sender <- async $ do-    let loop = do-          (must_shutdown, sps) <- atomically $ do-            must_shutdown <- readTVar shutdown_var-            sps <- flushTBQueue q-            case (must_shutdown, sps) of-              (False, []) -> retry-              _ -> pure (must_shutdown, sps)-          case sps of-            [] -> pure ()-            _ -> reportSpans endpoint manager cfg sps-          dd_ "must_shutdown" must_shutdown-          case must_shutdown of-            True -> pure ()-            False -> loop-    loop-  pure $! LightStepClient cfg sender q shutdown_var--reportSpans :: String -> Manager -> LightStepConfig -> [Span] -> IO ()-reportSpans endpoint httpManager cfg sps = do-  dd_ "reportSpans" sps-  let body = encode (map (ZipkinSpan cfg) sps)-      request =-        (parseRequest_ endpoint)-          { method = "POST",-            requestBody = RequestBodyLBS body,-            requestHeaders = [("Content-Type", "application/json")]-          }-  resp <- httpLbs request httpManager-  case statusCode (responseStatus resp) of-    200 -> do-      inc 1 reportedSpanCountVar-      pure ()-    _ -> do-      -- TODO(divanov): handle failures-      inc 1 rejectedSpanCountVar-      dd_ "body" body-      dd_ "resp status" $ responseStatus resp-      dd_ "resp" $ responseBody resp--droppedSpanCountVar :: TVar Int-droppedSpanCountVar = unsafePerformIO $ newTVarIO 0-{-# NOINLINE droppedSpanCountVar #-}--reportedSpanCountVar :: TVar Int-reportedSpanCountVar = unsafePerformIO $ newTVarIO 0-{-# NOINLINE reportedSpanCountVar #-}--rejectedSpanCountVar :: TVar Int-rejectedSpanCountVar = unsafePerformIO $ newTVarIO 0-{-# NOINLINE rejectedSpanCountVar #-}

@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module OpenTelemetry.Lightstep.Config where++import Control.Monad.IO.Class+import Data.Foldable+import Data.Maybe+import qualified Data.Text as T+import Network.Socket+import System.Environment+import System.IO++data LightstepConfig = LightstepConfig+  { lsHostName :: HostName,+    lsPort :: PortNumber,+    lsToken :: T.Text,+    lsServiceName :: T.Text,+    lsGlobalTags :: [(T.Text, T.Text)],+    lsGracefulShutdownTimeoutSeconds :: Word,+    lsSpanQueueSize :: Word+  }++lookupOneOfEnvs :: [String] -> IO (Maybe String)+lookupOneOfEnvs names = asum <$> traverse lookupEnv names++getEnvTagsWithPrefix :: T.Text -> IO [(T.Text, T.Text)]+getEnvTagsWithPrefix prefix =+  mapMaybe unprefix <$> getEnvironment+  where+    unprefix ((T.stripPrefix prefix . T.pack) -> Just k, v) = Just (k, T.pack v)+    unprefix _ = Nothing++getEnvConfig :: MonadIO m => m (Maybe LightstepConfig)+getEnvConfig = liftIO $ do+  prog_name <- getProgName+  maybe_token_from_env <- lookupOneOfEnvs ["LIGHTSTEP_TOKEN", "LIGHTSTEP_ACCESS_TOKEN", "OPENTRACING_LIGHTSTEP_ACCESS_TOKEN"]+  global_tags <- getEnvTagsWithPrefix "OPENTRACING_TAG_"+  case maybe_token_from_env of+    Just t -> do+      host <- fromMaybe "ingest.lightstep.com" <$> lookupOneOfEnvs ["LIGHTSTEP_HOST", "OPENTRACING_LIGHTSTEP_COLLECTOR_HOST"]+      port <- maybe 443 read <$> lookupOneOfEnvs ["LIGHTSTEP_PORT", "OPENTRACING_LIGHTSTEP_COLLECTOR_PORT"]+      service <- fromMaybe prog_name <$> lookupOneOfEnvs ["LIGHTSTEP_SERVICE", "OPENTRACING_LIGHTSTEP_COMPONENT_NAME"]+      pure $ Just $ LightstepConfig host port (T.pack t) (T.pack service) global_tags 5 4096+    Nothing -> do+      hPutStrLn stderr "LIGHTSTEP_ACCESS_TOKEN environment variable not defined"+      pure Nothing

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module OpenTelemetry.Lightstep.Exporter where++import Control.Concurrent.Async+import Control.Concurrent.STM+import Control.Monad.IO.Class+import Data.Aeson+import qualified Data.HashMap.Strict as HM+import Data.Scientific+import qualified Data.Text as T+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.HTTP.Types+import OpenTelemetry.Common+import OpenTelemetry.Exporter+import OpenTelemetry.Lightstep.Config+import OpenTelemetry.SpanContext+import OpenTelemetry.ZipkinExporter+import Text.Printf++createLightstepSpanExporter :: MonadIO m => LightstepConfig -> m (Exporter Span)+createLightstepSpanExporter cfg@(LightstepConfig {..}) = liftIO do+  let zcfg =+        ZipkinConfig+          { zEndpoint = printf "https://%s:%d/api/v2/spans" lsHostName (fromIntegral lsPort :: Int),+            zServiceName = lsServiceName,+            zGlobalTags =+              [ ("lightstep.component", lsServiceName),+                ("lightstep.access_token", lsToken)+              ],+            zSpanQueueSize = lsSpanQueueSize,+            zGracefulShutdownTimeoutSeconds = lsGracefulShutdownTimeoutSeconds+          }+  createZipkinSpanExporter zcfg