diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for hs-opentelemetry-sdk + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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: +- For more about OpenTelemetry Haskell: diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hs-opentelemetry-sdk.cabal b/hs-opentelemetry-sdk.cabal new file mode 100644 --- /dev/null +++ b/hs-opentelemetry-sdk.cabal @@ -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 +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 diff --git a/src/OpenTelemetry/Processor/Batch.hs b/src/OpenTelemetry/Processor/Batch.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Processor/Batch.hs @@ -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 + -} diff --git a/src/OpenTelemetry/Processor/Simple.hs b/src/OpenTelemetry/Processor/Simple.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Processor/Simple.hs @@ -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 + diff --git a/src/OpenTelemetry/Resource/Host/Detector.hs b/src/OpenTelemetry/Resource/Host/Detector.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Resource/Host/Detector.hs @@ -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{..} diff --git a/src/OpenTelemetry/Resource/OperatingSystem/Detector.hs b/src/OpenTelemetry/Resource/OperatingSystem/Detector.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Resource/OperatingSystem/Detector.hs @@ -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 + } diff --git a/src/OpenTelemetry/Resource/Process/Detector.hs b/src/OpenTelemetry/Resource/Process/Detector.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Resource/Process/Detector.hs @@ -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 + } diff --git a/src/OpenTelemetry/Resource/Service/Detector.hs b/src/OpenTelemetry/Resource/Service/Detector.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Resource/Service/Detector.hs @@ -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 + } diff --git a/src/OpenTelemetry/Resource/Telemetry/Detector.hs b/src/OpenTelemetry/Resource/Telemetry/Detector.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Resource/Telemetry/Detector.hs @@ -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 + } diff --git a/src/OpenTelemetry/Trace.hs b/src/OpenTelemetry/Trace.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Trace.hs @@ -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 diff --git a/src/OpenTelemetry/Trace/Id/Generator/Default.hs b/src/OpenTelemetry/Trace/Id/Generator/Default.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Trace/Id/Generator/Default.hs @@ -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 #-} diff --git a/test/OpenTelemetry/BaggageSpec.hs b/test/OpenTelemetry/BaggageSpec.hs new file mode 100644 --- /dev/null +++ b/test/OpenTelemetry/BaggageSpec.hs @@ -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 diff --git a/test/OpenTelemetry/ContextSpec.hs b/test/OpenTelemetry/ContextSpec.hs new file mode 100644 --- /dev/null +++ b/test/OpenTelemetry/ContextSpec.hs @@ -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 + diff --git a/test/OpenTelemetry/ResourceSpec.hs b/test/OpenTelemetry/ResourceSpec.hs new file mode 100644 --- /dev/null +++ b/test/OpenTelemetry/ResourceSpec.hs @@ -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 diff --git a/test/OpenTelemetry/TraceSpec.hs b/test/OpenTelemetry/TraceSpec.hs new file mode 100644 --- /dev/null +++ b/test/OpenTelemetry/TraceSpec.hs @@ -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 + + + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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