hs-opentelemetry-sdk (empty) → 0.0.1.0
raw patch · 19 files changed
+1233/−0 lines, 19 filesdep +asyncdep +basedep +bytestringsetup-changed
Dependencies added: async, base, bytestring, clock, hs-opentelemetry-api, hs-opentelemetry-exporter-otlp, hs-opentelemetry-propagator-w3c, hs-opentelemetry-sdk, hspec, http-types, mwc-random, network-bsd, random, random-bytestring, stm, text, unagi-chan, unix, unordered-containers, vector, vector-builder
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +19/−0
- Setup.hs +2/−0
- hs-opentelemetry-sdk.cabal +125/−0
- src/OpenTelemetry/Processor/Batch.hs +228/−0
- src/OpenTelemetry/Processor/Simple.hs +61/−0
- src/OpenTelemetry/Resource/Host/Detector.hs +60/−0
- src/OpenTelemetry/Resource/OperatingSystem/Detector.hs +21/−0
- src/OpenTelemetry/Resource/Process/Detector.hs +36/−0
- src/OpenTelemetry/Resource/Service/Detector.hs +20/−0
- src/OpenTelemetry/Resource/Telemetry/Detector.hs +15/−0
- src/OpenTelemetry/Trace.hs +265/−0
- src/OpenTelemetry/Trace/Id/Generator/Default.hs +32/−0
- test/OpenTelemetry/BaggageSpec.hs +8/−0
- test/OpenTelemetry/ContextSpec.hs +63/−0
- test/OpenTelemetry/ResourceSpec.hs +11/−0
- test/OpenTelemetry/TraceSpec.hs +219/−0
- test/Spec.hs +15/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for hs-opentelemetry-sdk++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ian Duncan (c) 2021++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 Ian Duncan 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,19 @@+# OpenTelemetry SDK for Haskell++This package provides everything a functioning implementation of+the OpenTelemetry the API, useful for exporting a variety of+tracing, logging, and metric data.++### Install Dependencies++Add `hs-opentelemetry-sdk` to your `package.yaml` or Cabal file.++### Trace Your Code++Visit the [GitHub project](https://github.com/iand675/hs-opentelemetry#readme) for a list of provided instrumentation libraries.++Examples of instrumented systems are available here: [Instrumentated application examples](https://github.com/iand675/hs-opentelemetry/blob/main/examples/README.md).++### Useful Links+- For more information on OpenTelemetry, visit: <https://opentelemetry.io/>+- For more about OpenTelemetry Haskell: <https://github.com/iand675/hs-opentelemetry>
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hs-opentelemetry-sdk.cabal view
@@ -0,0 +1,125 @@+cabal-version: 1.22++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: hs-opentelemetry-sdk+version: 0.0.1.0+synopsis: OpenTelemetry SDK for use in applications.+description: Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/sdk#readme>+category: OpenTelemetry, Telemetry, Monitoring, Observability, Metrics+homepage: https://github.com/iand675/hs-opentelemetry#readme+bug-reports: https://github.com/iand675/hs-opentelemetry/issues+author: Ian Duncan+maintainer: ian@iankduncan.com+copyright: 2021 Ian Duncan+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.Processor.Batch+ OpenTelemetry.Processor.Simple+ OpenTelemetry.Resource.Host.Detector+ OpenTelemetry.Resource.OperatingSystem.Detector+ OpenTelemetry.Resource.Process.Detector+ OpenTelemetry.Resource.Service.Detector+ OpenTelemetry.Resource.Telemetry.Detector+ OpenTelemetry.Trace+ OpenTelemetry.Trace.Id.Generator.Default+ other-modules:+ Paths_hs_opentelemetry_sdk+ reexported-modules:+ OpenTelemetry.Attributes+ , OpenTelemetry.Baggage+ , OpenTelemetry.Context+ , OpenTelemetry.Context.ThreadLocal+ , OpenTelemetry.Exporter+ , OpenTelemetry.Processor+ , OpenTelemetry.Propagator+ , OpenTelemetry.Resource+ , OpenTelemetry.Resource.Cloud+ , OpenTelemetry.Resource.Container+ , OpenTelemetry.Resource.DeploymentEnvironment+ , OpenTelemetry.Resource.Device+ , OpenTelemetry.Resource.FaaS+ , OpenTelemetry.Resource.Host+ , OpenTelemetry.Resource.Kubernetes+ , OpenTelemetry.Resource.OperatingSystem+ , OpenTelemetry.Resource.Process+ , OpenTelemetry.Resource.Service+ , OpenTelemetry.Resource.Telemetry+ , OpenTelemetry.Resource.Webengine+ , OpenTelemetry.Trace.Id+ , OpenTelemetry.Trace.Monad+ , OpenTelemetry.Trace.Sampler+ , OpenTelemetry.Trace.TraceState+ , OpenTelemetry.Util+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ async+ , base >=4.7 && <5+ , bytestring+ , hs-opentelemetry-api+ , hs-opentelemetry-exporter-otlp+ , hs-opentelemetry-propagator-w3c+ , http-types+ , mwc-random+ , network-bsd+ , random+ , random-bytestring+ , stm+ , text+ , unagi-chan+ , unix+ , unordered-containers+ , vector+ , vector-builder+ default-language: Haskell2010++test-suite hs-opentelemetry-sdk-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ OpenTelemetry.BaggageSpec+ OpenTelemetry.ContextSpec+ OpenTelemetry.ResourceSpec+ OpenTelemetry.TraceSpec+ Paths_hs_opentelemetry_sdk+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ async+ , base >=4.7 && <5+ , bytestring+ , clock+ , hs-opentelemetry-api+ , hs-opentelemetry-exporter-otlp+ , hs-opentelemetry-propagator-w3c+ , hs-opentelemetry-sdk+ , hspec+ , http-types+ , mwc-random+ , network-bsd+ , random+ , random-bytestring+ , stm+ , text+ , unagi-chan+ , unix+ , unordered-containers+ , vector+ , vector-builder+ default-language: Haskell2010
+ src/OpenTelemetry/Processor/Batch.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE RecordWildCards #-}+module OpenTelemetry.Processor.Batch+ ( BatchTimeoutConfig(..)+ , batchTimeoutConfig+ , batchProcessor+ -- , BatchProcessorOperations+ ) where+import Control.Monad.IO.Class+import OpenTelemetry.Processor+import OpenTelemetry.Exporter (Exporter)+import qualified OpenTelemetry.Exporter as Exporter+import VectorBuilder.Builder as Builder+import VectorBuilder.Vector as Builder+import Data.IORef (atomicModifyIORef', readIORef, newIORef)+import Control.Concurrent.Async+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, tryPutMVar)+import Control.Monad+import System.Timeout+import Control.Exception+import Data.HashMap.Strict (HashMap)+import OpenTelemetry.Trace.Core+import qualified Data.HashMap.Strict as HashMap+import Data.Vector (Vector)++-- | Configurable options for batch exporting frequence and size+data BatchTimeoutConfig = BatchTimeoutConfig+ { maxQueueSize :: Int+ -- ^ The maximum queue size. After the size is reached, spans are dropped.+ , scheduledDelayMillis :: Int+ -- ^ The delay interval in milliseconds between two consective exports.+ -- The default value is 5000.+ , exportTimeoutMillis :: Int+ -- ^ How long the export can run before it is cancelled.+ -- The default value is 30000.+ , maxExportBatchSize :: Int+ -- ^ The maximum batch size of every export. It must be+ -- smaller or equal to 'maxQueueSize'. The default value is 512.+ } deriving (Show)++-- | Default configuration values+batchTimeoutConfig :: BatchTimeoutConfig+batchTimeoutConfig = BatchTimeoutConfig+ { maxQueueSize = 1024+ , scheduledDelayMillis = 5000+ , exportTimeoutMillis = 30000+ , maxExportBatchSize = 512+ }++-- type BatchProcessorOperations = ()++-- A multi-producer single-consumer green/blue buffer.+-- Write requests that cannot fit in the live chunk will be dropped+--+-- TODO, would be cool to use AtomicCounters for this if possible+-- data GreenBlueBuffer a = GreenBlueBuffer+-- { gbReadSection :: !(TVar Word)+-- , gbWriteGreenOrBlue :: !(TVar Word)+-- , gbPendingWrites :: !(TVar Word)+-- , gbSectionSize :: !Int+-- , gbVector :: !(M.IOVector a)+-- }+++{- brainstorm: Single Word64 state sketch+++ 63 (high bit): green or blue+ 32-62: read section+ 0-32: write count+-}++{-++Green+ 512 512 512 512+|---------|---------|---------|---------|+ 0 1 2 3++Blue+ 512 512 512 512+|---------|---------|---------|---------|+ 0 1 2 3++The current read section denotes one chunk of length gbSize, which gets flushed+to the span exporter. Once the vector has been copied for export, gbReadSection+will be incremented.++-}++-- newGreenBlueBuffer +-- :: Int -- Max queue size (2048)+-- -> Int -- Export batch size (512)+-- -> IO (GreenBlueBuffer a)+-- newGreenBlueBuffer maxQueueSize batchSize = do+-- let logBase2 = finiteBitSize maxQueueSize - 1 - countLeadingZeros maxQueueSize++-- let closestFittingPowerOfTwo = 2 * if (1 `shiftL` logBase2) == maxQueueSize +-- then maxQueueSize +-- else 1 `shiftL` (logBase2 + 1)++-- readSection <- newTVarIO 0+-- writeSection <- newTVarIO 0+-- writeCount <- newTVarIO 0+-- buf <- M.new closestFittingPowerOfTwo+-- pure $ GreenBlueBuffer+-- { gbSize = maxQueueSize+-- , gbVector = buf+-- , gbReadSection = readSection+-- , gbPendingWrites = writeCount+-- }++-- isEmpty :: GreenBlueBuffer a -> STM Bool+-- isEmpty = do+-- c <- readTVar gbPendingWrites+-- pure (c == 0)++-- data InsertResult = ValueDropped | ValueInserted++-- tryInsert :: GreenBlueBuffer a -> a -> IO InsertResult+-- tryInsert GreenBlueBuffer{..} x = atomically $ do+-- c <- readTVar gbPendingWrites+-- if c == gbMaxLength+-- then pure ValueDropped+-- else do+-- greenOrBlue <- readTVar gbWriteGreenOrBlue+-- let i = c + ((M.length gbVector `shiftR` 1) `shiftL` (greenOrBlue `mod` 2))+-- M.write gbVector i x+-- writeTVar gbPendingWrites (c + 1)+-- pure ValueInserted++-- Caution, single writer means that this can't be called concurrently+-- consumeChunk :: GreenBlueBuffer a -> IO (V.Vector a)+-- consumeChunk GreenBlueBuffer{..} = atomically $ do+-- r <- readTVar gbReadSection+ -- w <- readTVar gbWriteSection+ -- c <- readTVar gbPendingWrites+ -- when (r == w) $ do+ -- modifyTVar gbWriteSection (+ 1)+ -- setTVar gbPendingWrites 0+ -- -- TODO slice and freeze appropriate section+ -- M.slice (gbSectionSize * (r .&. gbSectionMask) ++-- TODO, counters for dropped spans, exported spans++data BoundedSpanMap = BoundedSpanMap+ { itemBounds :: !Int+ , itemCount :: !Int+ , itemMap :: HashMap InstrumentationLibrary (Builder.Builder ImmutableSpan)+ }++boundedSpanMap :: Int -> BoundedSpanMap+boundedSpanMap bounds = BoundedSpanMap bounds 0 mempty++pushSpan :: ImmutableSpan -> BoundedSpanMap -> Maybe BoundedSpanMap+pushSpan s m = if itemCount m + 1 >= itemBounds m+ then Nothing+ else Just $! m+ { itemCount = itemCount m + 1+ , itemMap = HashMap.insertWith+ (<>)+ (tracerName $ spanTracer s)+ (Builder.singleton s) $+ itemMap m+ }++buildSpanExport :: BoundedSpanMap -> (BoundedSpanMap, HashMap InstrumentationLibrary (Vector ImmutableSpan))+buildSpanExport m =+ ( m { itemCount = 0, itemMap = mempty }+ , Builder.build <$> itemMap m+ )++-- |+-- The batch processor accepts spans and places them into batches. Batching helps better compress the data and reduce the number of outgoing connections +-- required to transmit the data. This processor supports both size and time based batching.+--+batchProcessor :: MonadIO m => BatchTimeoutConfig -> Exporter -> m Processor+batchProcessor BatchTimeoutConfig{..} exporter = liftIO $ do+ batch <- newIORef $ boundedSpanMap maxQueueSize+ workSignal <- newEmptyMVar+ worker <- async $ forever $ do+ void $ timeout (millisToMicros scheduledDelayMillis) $ takeMVar workSignal+ batchToProcess <- atomicModifyIORef' batch buildSpanExport+ Exporter.exporterExport exporter batchToProcess+++ pure $ Processor+ { processorOnStart = \_ _ -> pure ()+ , processorOnEnd = \s -> do+ span_ <- readIORef s+ appendFailed <- atomicModifyIORef' batch $ \builder ->+ case pushSpan span_ builder of+ Nothing -> (builder, True)+ Just b' -> (b', False)+ when appendFailed $ void $ tryPutMVar workSignal ()++ , processorForceFlush = void $ tryPutMVar workSignal ()+ -- TODO where to call restore, if anywhere?+ , processorShutdown = async $ mask $ \_restore -> do+ shutdownResult <- timeout (millisToMicros exportTimeoutMillis) $+ cancel worker+ -- TODO, not convinced we should shut down processor here++ case shutdownResult of+ Nothing -> pure ShutdownFailure+ Just _ -> pure ShutdownSuccess+ }+ where+ millisToMicros = (* 1000)+ {-+ buffer <- newGreenBlueBuffer _ _+ batchProcessorAction <- async $ forever $ do+ -- It would be nice to do an immediate send when possible+ chunk <- if (sendDelay == 0) + else consumeChunk+ then threadDelay sendDelay >> consumeChunk+ timeout _ $ export exporter chunk+ pure $ Processor+ { onStart = \_ _ -> pure ()+ , onEnd = \s -> void $ tryInsert buffer s+ , shutdown = do+ gracefullyShutdownBatchProcessor+ ++ , forceFlush = pure ()+ }+ where+ sendDelay = scheduledDelayMilis * 1_000+ -}
+ src/OpenTelemetry/Processor/Simple.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+module OpenTelemetry.Processor.Simple+ ( SimpleProcessorConfig(..)+ , simpleProcessor+ ) where++import Control.Exception+import Control.Concurrent.Async+import Control.Concurrent.Chan.Unagi+import Control.Monad+import Data.IORef+import OpenTelemetry.Processor+import OpenTelemetry.Trace.Core (ImmutableSpan, spanTracer, tracerName)+import qualified OpenTelemetry.Exporter as Exporter+import qualified Data.HashMap.Strict as HashMap++newtype SimpleProcessorConfig = SimpleProcessorConfig+ { exporter :: Exporter.Exporter+ -- ^ The exporter where the spans are pushed.+ }++-- | This is an implementation of SpanProcessor which passes finished spans +-- and passes the export-friendly span data representation to the configured SpanExporter, +-- as soon as they are finished.+--+-- @since 0.0.1.0+simpleProcessor :: SimpleProcessorConfig -> IO Processor+simpleProcessor SimpleProcessorConfig{..} = do+ (inChan :: InChan (IORef ImmutableSpan), outChan :: OutChan (IORef ImmutableSpan)) <- newChan+ exportWorker <- async $ forever $ do+ -- TODO, masking vs bracket here, not sure what's the right choice+ spanRef <- readChanOnException outChan (>>= writeChan inChan)+ span_ <- readIORef spanRef+ mask_ (exporter `Exporter.exporterExport` HashMap.singleton (tracerName $ spanTracer span_) (pure span_))++ pure $ Processor+ { processorOnStart = \_ _ -> pure ()+ , processorOnEnd = writeChan inChan + , processorShutdown = async $ mask $ \restore -> do+ cancel exportWorker+ -- TODO handle timeouts+ restore $ do+ -- TODO, not convinced we should shut down processor here+ shutdownProcessor outChan `finally` Exporter.exporterShutdown exporter+ pure ShutdownSuccess+ , processorForceFlush = pure ()+ }++ where+ shutdownProcessor :: OutChan (IORef ImmutableSpan) -> IO ()+ shutdownProcessor outChan = do+ (Element m, _) <- tryReadChan outChan+ mSpan <- m+ case mSpan of + Nothing -> pure ()+ Just spanRef -> do+ span_ <- readIORef spanRef+ _ <- exporter `Exporter.exporterExport` HashMap.singleton (tracerName $ spanTracer span_) (pure span_)+ shutdownProcessor outChan+
+ src/OpenTelemetry/Resource/Host/Detector.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module OpenTelemetry.Resource.Host.Detector where++import OpenTelemetry.Resource.Host++import qualified Data.Text as T+import Network.BSD+import Control.Monad+import System.Info (arch)++adaptedArch :: T.Text+adaptedArch = case arch of+ "aarch64" -> "arm64"+ "arm" -> "arm32"+ "x86_64" -> "amd64"+ "i386" -> "x86"+ "ia64" -> "ia64"+ "powerpc" -> "ppc32"+ "powerpc64" -> "ppc64"+ "powerpc64le" -> "ppc64"+ other -> T.pack other++-- | Detect as much host information as possible+detectHost :: IO Host+detectHost = do+ mhost <- foldM go Nothing builtInHostDetectors+ pure $ case mhost of+ Nothing -> Host Nothing Nothing Nothing Nothing Nothing Nothing Nothing+ Just host -> host+ where+ go Nothing hostDetector = hostDetector+ go mhost@(Just _host) _ = pure mhost++-- | A set of detectors for e.g. AWS, GCP, and other cloud providers.+--+-- Currently only emits hostName and hostArch. Additional detectors are+-- welcome via PR.+builtInHostDetectors :: [HostDetector]+builtInHostDetectors =+ [+ -- TODO+ -- AWS support+ -- GCP support+ -- any other user contributed+ fallbackHostDetector+ ]++type HostDetector = IO (Maybe Host)++fallbackHostDetector :: HostDetector+fallbackHostDetector = Just <$> do+ let hostId = Nothing+ hostType = Nothing+ hostArch = Just adaptedArch+ hostImageName = Nothing+ hostImageId = Nothing+ hostImageVersion = Nothing+ hostName <- Just . T.pack <$> getHostName+ pure Host{..}
+ src/OpenTelemetry/Resource/OperatingSystem/Detector.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+module OpenTelemetry.Resource.OperatingSystem.Detector where+import OpenTelemetry.Resource.OperatingSystem+import qualified Data.Text as T+import System.Info ( os )++-- | Retrieve any infomration able to be detected about the current operation system.+--+-- Currently only supports 'osType' detection, but PRs are welcome to support additional+-- details.+--+-- @since 0.0.1.0+detectOperatingSystem :: IO OperatingSystem +detectOperatingSystem = pure $ OperatingSystem+ { osType = if os == "mingw32"+ then "windows"+ else T.pack os+ , osDescription = Nothing+ , osName = Nothing+ , osVersion = Nothing+ }
+ src/OpenTelemetry/Resource/Process/Detector.hs view
@@ -0,0 +1,36 @@+module OpenTelemetry.Resource.Process.Detector where++import qualified Data.Text as T+import System.Environment+ ( getArgs, getProgName, getExecutablePath )+import System.Posix.Process ( getProcessID )+import System.Posix.User (getEffectiveUserName)+import System.Info+import Data.Version+import OpenTelemetry.Resource.Process++-- | Create a 'Process' 'Resource' based off of the current process' knowledge+-- of itself.+--+-- @since 0.1.0.0+detectProcess :: IO Process+detectProcess = do+ Process <$>+ (Just . fromIntegral <$> getProcessID) <*>+ (Just . T.pack <$> getProgName) <*>+ (Just . T.pack <$> getExecutablePath) <*>+ pure Nothing <*>+ pure Nothing <*>+ (Just . map T.pack <$> getArgs) <*>+ (Just . T.pack <$> getEffectiveUserName)++-- | A 'ProcessRuntime' 'Resource' populated with the current process' knoweldge+-- of itself.+--+-- @since 0.0.1.0+detectProcessRuntime :: ProcessRuntime+detectProcessRuntime = ProcessRuntime+ { processRuntimeName = Just $ T.pack compilerName+ , processRuntimeVersion = Just $ T.pack $ showVersion compilerVersion+ , processRuntimeDescription = Nothing+ }
+ src/OpenTelemetry/Resource/Service/Detector.hs view
@@ -0,0 +1,20 @@+module OpenTelemetry.Resource.Service.Detector where++import qualified Data.Text as T+import OpenTelemetry.Resource.Service+import System.Environment (lookupEnv, getProgName)++-- | Detect a service name using the 'OTEL_SERVICE_NAME' environment+-- variable. Otherwise, populates the name with 'unknown_service:process_name'.+detectService :: IO Service+detectService = do+ mSvcName <- lookupEnv "OTEL_SERVICE_NAME"+ svcName <- case mSvcName of+ Nothing -> T.pack . ("unknown_service:" <>) <$> getProgName+ Just svcName -> pure $ T.pack svcName+ pure $ Service+ { serviceName = svcName+ , serviceNamespace = Nothing+ , serviceInstanceId = Nothing+ , serviceVersion = Nothing+ }
+ src/OpenTelemetry/Resource/Telemetry/Detector.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}+module OpenTelemetry.Resource.Telemetry.Detector where+import qualified Data.Text as T+import Data.Version (showVersion)+import OpenTelemetry.Resource.Telemetry+import Paths_hs_opentelemetry_sdk++-- | Built-in information about this package+detectTelemetry :: Telemetry+detectTelemetry = Telemetry+ { telemetrySdkName = "hs-opentelemetry-sdk"+ , telemetrySdkLanguage = Just "haskell"+ , telemetrySdkVersion = Just $ T.pack $ showVersion version+ , telemetryAutoVersion = Nothing+ }
+ src/OpenTelemetry/Trace.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DataKinds #-}+module OpenTelemetry.Trace + ( + -- * 'TracerProvider' operations+ TracerProvider+ , initializeGlobalTracerProvider+ , initializeTracerProvider+ , getTracerProviderInitializationOptions+ , shutdownTracerProvider+ -- ** Getting / setting the global 'TracerProvider'+ , getGlobalTracerProvider+ , setGlobalTracerProvider+ -- ** Alternative 'TracerProvider' initialization+ , createTracerProvider+ , TracerProviderOptions(..)+ , emptyTracerProviderOptions+ , detectBuiltInResources+ -- * 'Tracer' operations+ , Tracer+ , tracerName+ , getTracer+ , TracerOptions(..)+ , tracerOptions+ , HasTracer(..)+ , InstrumentationLibrary(..)+ -- * 'Span' operations+ , Span+ , createSpan+ , createSpanWithoutCallStack+ , defaultSpanArguments+ , SpanArguments(..)+ , updateName+ , addAttribute + , addAttributes+ , spanGetAttributes+ , ToAttribute(..)+ , ToPrimitiveAttribute(..)+ , Attribute(..)+ , PrimitiveAttribute(..)+ , SpanKind(..)+ , Link(..)+ , Event+ , NewEvent(..)+ , addEvent+ , recordException+ , setStatus+ , SpanStatus(..)+ , SpanContext(..)+ , endSpan+ -- TODO, don't remember if this is okay with the spec or not+ , ImmutableSpan(..)+ ) where++import OpenTelemetry.Trace.Core+import OpenTelemetry.Resource+import Data.Maybe (fromMaybe)+import Data.Either (partitionEithers)+import qualified Data.Text as T+import OpenTelemetry.Context (Context)+import Network.HTTP.Types.Header+import OpenTelemetry.Propagator.W3CTraceContext (w3cTraceContextPropagator)+import OpenTelemetry.Propagator.W3CBaggage (w3cBaggagePropagator)+import OpenTelemetry.Propagator (Propagator)+import System.Environment (lookupEnv)+import OpenTelemetry.Trace.Sampler (Sampler, alwaysOn, alwaysOff, traceIdRatioBased, parentBased, parentBasedOptions)+import Text.Read (readMaybe)+import OpenTelemetry.Exporter (Exporter)+import OpenTelemetry.Processor.Batch (BatchTimeoutConfig (..), batchTimeoutConfig, batchProcessor)+import OpenTelemetry.Attributes (AttributeLimits(..), defaultAttributeLimits)+import OpenTelemetry.Baggage (decodeBaggageHeader)+import qualified Data.ByteString.Char8 as B+import qualified OpenTelemetry.Baggage as Baggage+import qualified Data.HashMap.Strict as H+import Data.Text.Encoding (decodeUtf8)+import OpenTelemetry.Exporter.OTLP (loadExporterEnvironmentVariables, otlpExporter)+import OpenTelemetry.Processor (Processor)+import OpenTelemetry.Resource.Service.Detector (detectService)+import OpenTelemetry.Resource.Process.Detector (detectProcess, detectProcessRuntime)+import OpenTelemetry.Resource.OperatingSystem.Detector (detectOperatingSystem)+import OpenTelemetry.Resource.Host.Detector (detectHost)+import OpenTelemetry.Resource.Telemetry.Detector (detectTelemetry)+import OpenTelemetry.Trace.Id.Generator.Default (defaultIdGenerator)++knownPropagators :: [(T.Text, Propagator Context RequestHeaders ResponseHeaders)]+knownPropagators =+ [ ("tracecontext", w3cTraceContextPropagator)+ , ("baggage", w3cBaggagePropagator)+ , ("b3", error "B3 not yet implemented")+ , ("b3multi", error "B3 multi not yet implemented")+ , ("jaeger", error "Jaeger not yet implemented")+ ]++-- TODO, actually implement a registry systme+readRegisteredPropagators :: IO [(T.Text, Propagator Context RequestHeaders ResponseHeaders)]+readRegisteredPropagators = pure knownPropagators++initializeGlobalTracerProvider :: IO TracerProvider+initializeGlobalTracerProvider = do+ t <- initializeTracerProvider+ setGlobalTracerProvider t+ pure t++initializeTracerProvider :: IO TracerProvider+initializeTracerProvider = do+ (processors, opts) <- getTracerProviderInitializationOptions+ createTracerProvider processors opts++getTracerProviderInitializationOptions :: IO ([Processor], TracerProviderOptions)+getTracerProviderInitializationOptions = do+ sampler <- detectSampler+ attrLimits <- detectAttributeLimits+ spanLimits <- detectSpanLimits+ propagators <- detectPropagators+ processorConf <- detectBatchProcessorConfig+ exporters <- detectExporters+ builtInRs <- detectBuiltInResources+ envVarRs <- (mkResource . map Just) <$> detectResourceAttributes+ let allRs = builtInRs <> envVarRs+ processors <- case exporters of+ [] -> do+ pure []+ e:_ -> do+ pure <$> batchProcessor processorConf e+ let providerOpts = emptyTracerProviderOptions+ { tracerProviderOptionsIdGenerator = defaultIdGenerator+ , tracerProviderOptionsSampler = sampler+ , tracerProviderOptionsAttributeLimits = attrLimits+ , tracerProviderOptionsSpanLimits = spanLimits+ , tracerProviderOptionsPropagators = propagators+ , tracerProviderOptionsResources = materializeResources allRs+ }+ pure (processors, providerOpts)++detectPropagators :: IO (Propagator Context RequestHeaders ResponseHeaders)+detectPropagators = do+ registeredPropagators <- readRegisteredPropagators+ propagatorsInEnv <- fmap (T.splitOn "," . T.pack) <$> lookupEnv "OTEL_PROPAGATORS"+ if propagatorsInEnv == Just ["none"]+ then pure mempty+ else do+ let envPropagators = fromMaybe ["tracecontext", "baggage"] propagatorsInEnv+ propagatorsAndRegistryEntry = map (\k -> maybe (Left k) Right $ lookup k registeredPropagators) envPropagators+ (_notFound, propagators) = partitionEithers propagatorsAndRegistryEntry+ -- TODO log warn notFound+ pure $ mconcat propagators++knownSamplers :: [(T.Text, Maybe T.Text -> Maybe Sampler)]+knownSamplers =+ [ ("always_on", const $ pure alwaysOn)+ , ("always_off", const $ pure alwaysOff)+ , ("traceidratio", \case+ Nothing -> Nothing + Just val -> case readMaybe (T.unpack val) of+ Nothing -> Nothing+ Just ratioVal -> pure $ traceIdRatioBased ratioVal+ )+ , ("parentbased_always_on", const $ pure $ parentBased $ parentBasedOptions alwaysOn)+ , ("parentbased_always_off", const $ pure $ parentBased $ parentBasedOptions alwaysOff)+ , ("parentbased_traceidratio", \case+ Nothing -> Nothing + Just val -> case readMaybe (T.unpack val) of+ Nothing -> Nothing+ Just ratioVal -> pure $ parentBased $ parentBasedOptions $ traceIdRatioBased ratioVal+ )+ ]++-- TODO MUST log invalid arg+detectSampler :: IO Sampler+detectSampler = do+ envSampler <- lookupEnv "OTEL_TRACES_SAMPLER"+ envArg <- lookupEnv "OTEL_TRACES_SAMPLER_ARG"+ let sampler = fromMaybe (parentBased $ parentBasedOptions alwaysOn) $ do+ samplerName <- envSampler+ samplerConstructor <- lookup (T.pack samplerName) knownSamplers+ samplerConstructor (T.pack <$> envArg)+ pure sampler++detectBatchProcessorConfig :: IO BatchTimeoutConfig+detectBatchProcessorConfig = BatchTimeoutConfig + <$> readEnvDefault "OTEL_BSP_MAX_QUEUE_SIZE" (maxQueueSize batchTimeoutConfig)+ <*> readEnvDefault "OTEL_BSP_SCHEDULE_DELAY" (scheduledDelayMillis batchTimeoutConfig)+ <*> readEnvDefault "OTEL_BSP_EXPORT_TIMEOUT" (exportTimeoutMillis batchTimeoutConfig)+ <*> readEnvDefault "OTEL_BSP_MAX_EXPORT_BATCH_SIZE" (maxExportBatchSize batchTimeoutConfig)++detectAttributeLimits :: IO AttributeLimits+detectAttributeLimits = AttributeLimits+ <$> readEnvDefault "OTEL_ATTRIBUTE_COUNT_LIMIT" (attributeCountLimit defaultAttributeLimits)+ <*> ((>>= readMaybe) <$> lookupEnv "OTEL_ATTRIBUTE_VALUE_LENGTH_LIMIT")++detectSpanLimits :: IO SpanLimits+detectSpanLimits = SpanLimits+ <$> readEnv "OTEL_SPAN_ATTRIBUTE_VALUE_LENGTH_LIMIT"+ <*> readEnv "OTEL_SPAN_ATTRIBUTE_COUNT_LIMIT"+ <*> readEnv "OTEL_SPAN_EVENT_COUNT_LIMIT"+ <*> readEnv "OTEL_SPAN_LINK_COUNT_LIMIT"+ <*> readEnv "OTEL_EVENT_ATTRIBUTE_COUNT_LIMIT"+ <*> readEnv "OTEL_LINK_ATTRIBUTE_COUNT_LIMIT"++knownExporters :: [(T.Text, IO Exporter)]+knownExporters =+ [ ("otlp", do+ otlpConfig <- loadExporterEnvironmentVariables+ otlpExporter otlpConfig+ )+ , ("jaeger", error "Jaeger exporter not implemented")+ , ("zipkin", error "Zipkin exporter not implemented")+ ]++-- TODO, rename Exporter to Exporter+-- TODO, support multiple exporters+detectExporters :: IO [Exporter]+detectExporters = do+ exportersInEnv <- fmap (T.splitOn "," . T.pack) <$> lookupEnv "OTEL_TRACES_EXPORTER"+ if exportersInEnv == Just ["none"]+ then pure []+ else do+ let envExporters = fromMaybe ["otlp"] exportersInEnv+ exportersAndRegistryEntry = map (\k -> maybe (Left k) Right $ lookup k knownExporters) envExporters+ (_notFound, exporterIntializers) = partitionEithers exportersAndRegistryEntry+ -- TODO, notFound logging+ sequence exporterIntializers++ -- -- detectMetricsExporterSelection :: _+ -- -- TODO other metrics stuff++detectResourceAttributes :: IO [(T.Text, Attribute)]+detectResourceAttributes = do+ mEnv <- lookupEnv "OTEL_RESOURCE_ATTRIBUTES"+ case mEnv of+ Nothing -> pure []+ Just envVar -> case decodeBaggageHeader $ B.pack envVar of+ Left err -> do+ -- TODO logError+ putStrLn err+ pure []+ Right ok ->+ pure+ $ map (\(k, v) -> (decodeUtf8 $ Baggage.tokenValue k, toAttribute $ Baggage.value v))+ $ H.toList+ $ Baggage.values ok++readEnvDefault :: forall a. Read a => String -> a -> IO a +readEnvDefault k defaultValue =+ fromMaybe defaultValue . (>>= readMaybe) <$> lookupEnv k++readEnv :: forall a. Read a => String -> IO (Maybe a)+readEnv k = (>>= readMaybe) <$> lookupEnv k++detectBuiltInResources :: IO (Resource 'Nothing)+detectBuiltInResources = do+ svc <- detectService+ processInfo <- detectProcess+ osInfo <- detectOperatingSystem+ host <- detectHost+ let rs =+ toResource svc `mergeResources`+ toResource detectTelemetry `mergeResources`+ toResource detectProcessRuntime `mergeResources`+ toResource processInfo `mergeResources`+ toResource osInfo `mergeResources`+ toResource host+ pure rs
+ src/OpenTelemetry/Trace/Id/Generator/Default.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE CPP #-}+module OpenTelemetry.Trace.Id.Generator.Default + ( defaultIdGenerator+ ) where++import System.Random.MWC+#if MIN_VERSION_random(1,2,0)+import System.Random.Stateful+#else+import Data.ByteString.Random+#endif+import System.IO.Unsafe (unsafePerformIO)+import OpenTelemetry.Trace.Id.Generator (IdGenerator(..))++-- | The default generator for trace and span ids.+--+-- @since 0.1.0.0+defaultIdGenerator :: IdGenerator+defaultIdGenerator = unsafePerformIO $ do+ g <- createSystemRandom+#if MIN_VERSION_random(1,2,0)+ pure $ IdGenerator+ { generateSpanIdBytes = uniformByteStringM 8 g+ , generateTraceIdBytes = uniformByteStringM 16 g+ }+#else+ pure $ IdGenerator+ { generateSpanIdBytes = randomGen g 8+ , generateTraceIdBytes = randomGen g 16+ }+#endif+{-# NOINLINE defaultIdGenerator #-}
+ test/OpenTelemetry/BaggageSpec.hs view
@@ -0,0 +1,8 @@+module OpenTelemetry.BaggageSpec where++import Test.Hspec++spec :: Spec+spec = describe "Baggage" $ do+ specify "Basic support" pending+ specify "User official header name `baggage`" pending
+ test/OpenTelemetry/ContextSpec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+module OpenTelemetry.ContextSpec where+import Control.Monad+import Data.Maybe+import OpenTelemetry.Context+import OpenTelemetry.Context.ThreadLocal+import Test.Hspec+import Prelude hiding (lookup)++spec :: Spec+spec = describe "Context" $ do+ describe "Create Context Key" $ do+ it "works" $ do+ void (newKey "k" :: IO (Key ()))+ describe "Set value for Context" $ do+ it "works" $ do+ k <- newKey "k"+ let ctxt = insert k (12 :: Int) empty+ lookup k ctxt `shouldBe` Just 12+ describe "Get value from Context" $ do+ it "works" $ do+ k1 <- newKey "k.1"+ k2 <- newKey "k.2"+ let ctxt = insert k2 (Just False) $ insert k1 (12 :: Int) empty+ lookup k1 ctxt `shouldBe` Just 12+ lookup k2 ctxt `shouldBe` (Just (Just False))+ describe "Attach Context" $ do+ specify "ThreadLocal works" $ do+ k <- newKey "thingum"+ attachContext $ insert k True empty+ mctxt <- lookupContext+ (mctxt >>= lookup k) `shouldBe` Just True+ describe "Detach Context" $ do+ specify "ThreadLocal works" $ do+ k <- newKey "thingum"+ attachContext $ insert k True empty+ mctxt <- detachContext+ (mctxt >>= lookup k) `shouldBe` Just True+ mctxt' <- lookupContext+ isNothing mctxt' `shouldBe` True++ specify "Get current Context" $ do+ k1 <- newKey "k.1"+ k2 <- newKey "k.2"+ let ctxt1 = insert k1 (12 :: Int) empty+ attachContext ctxt1+ let ctxt2 = insert k2 (13 :: Int) empty+ attachContext ctxt2+ (Just ctxt) <- lookupContext+ lookup k1 ctxt `shouldBe` Nothing+ lookup k2 ctxt `shouldBe` Just 13++ specify "Composite Propagator" pending+ specify "Global Propagator" pending+ specify "TraceContext Propagator" pending+ specify "B3 Propagator" pending+ specify "Jaeger Propagator" pending+ describe "TextMap Propagator" $ do+ specify "Fields" pending+ specify "Setter argument" pending+ specify "Getter argument" pending+ specify "Getter argument returning keys" pending+
+ test/OpenTelemetry/ResourceSpec.hs view
@@ -0,0 +1,11 @@+module OpenTelemetry.ResourceSpec where++import Test.Hspec++spec :: Spec+spec = describe "Resource" $ do+ specify "Create from Attributes" pending+ specify "Create empty" pending+ specify "Merge (v2)" pending+ specify "Retrieve attributes" pending+ specify "Default value for service.name" pending
+ test/OpenTelemetry/TraceSpec.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+module OpenTelemetry.TraceSpec where++import Control.Monad+import Data.Int+import Data.IORef+import Data.Text (Text)+import qualified OpenTelemetry.Context as Context+import OpenTelemetry.Trace+import OpenTelemetry.Trace.Core+import OpenTelemetry.Trace.Id+import OpenTelemetry.Trace.Id.Generator+import OpenTelemetry.Trace.Id.Generator.Default+import qualified OpenTelemetry.Trace.TraceState as TraceState+import Test.Hspec+import System.Clock++asIO :: IO a -> IO a+asIO = id++spec :: Spec+spec = describe "Trace" $ do++ describe "TracerProvider" $ do+ specify "Create TracerProvider" $ do+ void (createTracerProvider [] (emptyTracerProviderOptions :: TracerProviderOptions) :: IO TracerProvider)+ specify "Get a Tracer" $ asIO $ do+ p <- getGlobalTracerProvider+ void $ getTracer p "woo" tracerOptions+ specify "Get a Tracer with schema_url" $ asIO $ do+ p <- getGlobalTracerProvider+ void $ getTracer p "woo" (tracerOptions { tracerSchema = Just "https://woo.com" })+ specify "Safe for concurrent calls" pending+ specify "Shutdown" pending+ specify "ForceFlush" pending++ describe "Trace / Context interaction" $ do+ specify "Set active span, Get active span" $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ spanContext1 <- spanContext <$> unsafeReadSpan s+ let ctxt = Context.insertSpan s mempty+ let Just s' = Context.lookupSpan ctxt+ spanContext2 <- spanContext <$> unsafeReadSpan s'+ spanContext1 `shouldBe` spanContext2++ describe "Tracer" $ do+ specify "Create a new span" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ void $ createSpan t Context.empty "create_root_span" defaultSpanArguments+ specify "Get active new span" pending+ specify "Mark Span active" pending+ specify "Safe for concurrent calls" pending+ describe "SpanContext" $ do+ specify "IsValid" $ do+ t <- newTraceId defaultIdGenerator+ s <- newSpanId defaultIdGenerator+ let (Right goodSpan) = bytesToSpanId "\1\0\0\0\0\0\0\1"+ (Right goodTrace) = bytesToTraceId "\1\0\0\0\0\0\0\0\0\0\0\0\0\0\0\1"+ (Right badSpan) = bytesToSpanId "\0\0\0\0\0\0\0\0"+ (Right badTrace) = bytesToTraceId "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"+ validSpan = SpanContext+ { traceFlags = defaultTraceFlags+ , isRemote = False+ , traceState = TraceState.empty+ , spanId = goodSpan+ , traceId = goodTrace+ }+ validSpan `shouldSatisfy` isValid+ (validSpan { spanId = badSpan, traceId = badTrace }) `shouldSatisfy` (not . isValid)+ specify "IsRemote" pending+ specify "Conforms to the W3C TraceContext spec" pending+ describe "Span" $ do+ specify "Create root span" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ void $ createSpan t Context.empty "create_root_span" defaultSpanArguments+ specify "Create with default parent (active span)" pending+ specify "Create with parent from Context" pending+ -- specify "No explict parent from Span/SpanContext allowed" pending+ specify "Processor.OnStart receives parent Context" pending+ specify "UpdateName" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ updateName s "renamed_span"+ specify "User-defined start timestamp" pending+ specify "End" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ endSpan s Nothing+ specify "End with timestamp" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ ts <- getTimestamp+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ endSpan s (Just ts)+ specify "IsRecording" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ ts <- getTime Realtime+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ recording <- isRecording s+ recording `shouldBe` True++ specify "IsRecording becomes false after End" $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ ts <- getTime Realtime+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ endSpan s Nothing+ recording <- isRecording s+ recording `shouldBe` False++ specify "Set status with StatusCode (Unset, Ok, Error)" $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ ts <- getTime Realtime+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments++ setStatus s $ Error "woo"+ do+ i <- unsafeReadSpan s+ spanStatus i `shouldBe` Error "woo"+ setStatus s $ Ok+ do+ i <- unsafeReadSpan s+ spanStatus i `shouldBe` Ok+ setStatus s $ Error "woo"+ do+ i <- unsafeReadSpan s+ spanStatus i `shouldBe` Ok+++ specify "Safe for concurrent calls" pending+ specify "events collection size limit" pending+ specify "attribute collection size limit" pending+ specify "links collection size limit" pending++ describe "Span attributes" $ do+ specify "SetAttribute" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ addAttribute s "attr" (1.0 :: Double)+ + specify "Set order preserved" pending+ specify "String type" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ addAttribute s "string_type" ("" :: Text)++ specify "Boolean type" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ addAttribute s "bool_type" True++ specify "Double floating-point type" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ addAttribute s "attr" (1.0 :: Double)++ specify "Signed int64 type" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ addAttribute s "attr" (1 :: Int64)++ specify "Array of primitives (homegeneous)" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ addAttribute s "attr" [(1 :: Int64)..10]++ specify "Unicode support for keys and string values" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ addAttribute s "🚀" ("🚀" :: Text)+ -- TODO actually get attributes out+++ describe "Span events" $ do+ specify "AddEvent" $ asIO $ do+ p <- getGlobalTracerProvider+ t <- getTracer p "woo" tracerOptions+ s <- createSpan t Context.empty "create_root_span" defaultSpanArguments+ addEvent s $ NewEvent+ { newEventName = "EVENT"+ , newEventAttributes = []+ , newEventTimestamp = Nothing+ }+ specify "Add order preserved" pending+ specify "Safe for concurrent calls" pending++ describe "Span exceptions" $ do+ specify "RecordException" pending+ specify "RecordException with extra parameters" pending++ describe "Sampling" $ do+ specify "Allow samplers to modify tracestate" pending+ specify "ShouldSample gets full parent Context" pending+ specify "ShouldSample gets InstrumentationLibrary" pending++ specify "New Span ID created also for non-recording spans" pending+ specify "IdGenerators" pending+ specify "SpanLimits" pending+ specify "Built-in Processors implement ForceFlush spec" pending+ specify "Attribute Limits" pending+++
+ test/Spec.hs view
@@ -0,0 +1,15 @@+import OpenTelemetry.Trace (initializeGlobalTracerProvider)+import qualified OpenTelemetry.BaggageSpec as BaggageSpec+import qualified OpenTelemetry.ContextSpec as ContextSpec+import qualified OpenTelemetry.TraceSpec as TraceSpec+import qualified OpenTelemetry.ResourceSpec as ResourceSpec+import Test.Hspec++main :: IO ()+main = do+ initializeGlobalTracerProvider+ hspec $ do+ BaggageSpec.spec+ ContextSpec.spec+ TraceSpec.spec+ ResourceSpec.spec