Add opentelemetry-lightstep subproject

Author: ethercrow

.github/workflows/ci.yml

@@ -27,6 +27,14 @@ jobs:
       run: |
         cd opentelemetry
         cabal test
+    - name: Build opentelemetry-lightstep
+      run: |
+        cd opentelemetry-lightstep
+        cabal build -f examples
+    - name: Test opentelemetry-lightstep
+      run: |
+        cd opentelemetry-lightstep
+        cabal test
 
   linux-stack-lts-14:
     runs-on: ubuntu-18.04

opentelemetry-lightstep/LICENSE

@@ -0,0 +1,7 @@
+Copyright 2020-present Dmitry Ivanov
+
+Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at
+
+http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.

opentelemetry-lightstep/just-some-usage-code-that-must-compile/Main.hs

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

opentelemetry-lightstep/just-some-usage-code-that-must-compile/SomeUsageOfImplicitApi.hs

@@ -0,0 +1,55 @@
+{-# 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 "rpc roundtrip begin"
+  withSpan "leveraging synergies" $ do
+    threadDelay 10000
+    addEvent "enough synergies leveraged"
+  addEvent "All your base are belong to us"
+  addEvent "rpc roundtrip end"
+  withSpan "project" $ do
+    -- Connecting spans across threads requires some manual plumbing
+    sp <- getCurrentActiveSpan
+    asyncWork <- async $ withChildSpanOf sp "data science" $ do
+      threadDelay 1000000
+      pure 42
+    -- Doing a withSpan inside a loop is fine
+    forM_ [input .. input + 10] $ \i -> withSpan "sprint" $ do
+      -- setTag "week" i
+      threadDelay 10000
+    wait asyncWork
+  pure result

opentelemetry-lightstep/opentelemetry-lightstep.cabal

@@ -0,0 +1,65 @@
+cabal-version:       2.4
+name:                opentelemetry-lightstep
+version:             0.1.0.0
+license-file:        LICENSE
+author:              Dmitry Ivanov
+maintainer:          [email protected]
+build-type:          Simple
+
+source-repository head
+  type: git
+  location: https://github.com/ethercrow/opentelemetry-haskell
+
+common options
+  default-language: Haskell2010
+  default-extensions:
+    BangPatterns
+    BlockArguments
+    DataKinds
+    FlexibleInstances
+    LambdaCase
+    MultiParamTypeClasses
+    MultiWayIf
+    NamedFieldPuns
+    NumericUnderscores
+    RecordWildCards
+    ScopedTypeVariables
+    TupleSections
+    TypeApplications
+    ViewPatterns
+  ghc-options:
+    -Wall
+    -Wcompat
+    -Widentities
+    -Wincomplete-record-updates
+    -Wincomplete-uni-patterns
+    -Wpartial-fields
+    -Wredundant-constraints
+    -fhide-source-paths
+    -ferror-spans
+    -freverse-errors
+
+library
+  import: options
+  build-depends:
+    base >= 4.12,
+    opentelemetry,
+    text,
+    unordered-containers
+  hs-source-dirs: src
+  exposed-modules:
+    OpenTelemetry.LightStepExporter
+
+test-suite just-some-usage-code-that-must-compile
+  import: options
+  type:       exitcode-stdio-1.0
+  main-is:    Main.hs
+  other-modules:
+    SomeUsageOfImplicitApi
+  hs-source-dirs: just-some-usage-code-that-must-compile
+  build-depends:
+    base,
+    async,
+    opentelemetry,
+    opentelemetry-lightstep
+

opentelemetry-lightstep/src/OpenTelemetry/LightStep/Config.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module LightStep.Config where
+
+import Control.Monad.IO.Class
+import Data.Foldable
+import Data.Maybe
+import qualified Data.Text as T
+import Network.HTTP2.Client
+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 :: Int
+      }
+
+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
+  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 "example-haskell-service" <$> lookupOneOfEnvs ["LIGHTSTEP_SERVICE", "OPENTRACING_LIGHTSTEP_COMPONENT_NAME"]
+      pure $ Just $ LightStepConfig host port (T.pack t) (T.pack service) global_tags 5
+    Nothing -> do
+      hPutStrLn stderr "LIGHTSTEP_ACCESS_TOKEN environment variable not defined"
+      pure Nothing

opentelemetry-lightstep/src/OpenTelemetry/LightStep/Exporter.hs

@@ -0,0 +1,20 @@
+module OpenTelemetry.LightStepExporter where
+
+import Data.Function
+import qualified Data.HashMap.Strict as HM
+import Data.List
+import qualified Data.Text as T
+import OpenTelemetry.Common
+import System.IO
+import Text.Printf
+
+createLightStepExporter :: LightStepConfig -> IO (Exporter Span)
+createLightStepExporter LightStepConfig {..} = do
+  pure
+    $! Exporter
+      ( \sps -> do
+          pure ExportSuccess
+      )
+      ( do
+          pure ()
+      )

stack-8.8.1.yaml

@@ -2,3 +2,4 @@ resolver: nightly-2020-01-04
 
 packages:
 - opentelemetry
+- opentelemetry-lightstep

stack.yaml

@@ -2,3 +2,4 @@ resolver: lts-14.19
 
 packages:
 - opentelemetry
+- opentelemetry-lightstep