opentelemetry 0.5.3 → 0.6.0
raw patch · 5 files changed
+266/−22 lines, 5 files
Files
- opentelemetry.cabal +2/−3
- src/OpenTelemetry/Eventlog.hs +87/−3
- src/OpenTelemetry/Eventlog_Internal.hs +43/−1
- src/OpenTelemetry/Exporter.hs +0/−15
- src/OpenTelemetry/Metrics_Internal.hs +134/−0
opentelemetry.cabal view
@@ -2,7 +2,7 @@ name: opentelemetry description: The OpenTelemetry Haskell Client https://opentelemetry.io category: OpenTelemetry-version: 0.5.3+version: 0.6.0 license-file: LICENSE license: Apache-2.0 author: Dmitry Ivanov@@ -56,8 +56,7 @@ hs-source-dirs: src exposed-modules: OpenTelemetry.SpanContext- OpenTelemetry.Exporter OpenTelemetry.Propagation OpenTelemetry.Eventlog OpenTelemetry.Eventlog_Internal-+ OpenTelemetry.Metrics_Internal
src/OpenTelemetry/Eventlog.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} module OpenTelemetry.Eventlog- ( beginSpan,+ ( -- * Spans+ beginSpan, endSpan, withSpan, withSpan_,@@ -13,8 +15,32 @@ addEvent, setParentSpanContext, SpanInFlight (..),- )-where+ -- * Metrics+ mkCounter,+ mkUpDownCounter,+ mkValueRecorder,+ mkSumObserver,+ mkUpDownSumObserver,+ mkValueObserver,+ add,+ record,+ observe,+ MI.Instrument,+ MI.SomeInstrument(..),+ MI.Counter,+ MI.UpDownCounter,+ MI.ValueRecorder,+ MI.SumObserver,+ MI.UpDownSumObserver,+ MI.ValueObserver,+ MI.Synchronicity(..),+ MI.Additivity(..),+ MI.Monotonicity(..),+ MI.InstrumentName,+ MI.InstrumentId,+ MI.instrumentName,+ MI.instrumentId+ ) where import Control.Monad.Catch import Control.Monad.IO.Class@@ -23,6 +49,7 @@ import OpenTelemetry.Eventlog_Internal (SpanInFlight (..)) import qualified OpenTelemetry.Eventlog_Internal as I import OpenTelemetry.SpanContext+import qualified OpenTelemetry.Metrics_Internal as MI {-# INLINE withSpan #-} withSpan ::@@ -82,3 +109,60 @@ {-# INLINE setParentSpanContext #-} setParentSpanContext :: MonadIO m => SpanInFlight -> SpanContext -> m () setParentSpanContext sp ctx = I.traceBuilder $ I.builder_setParentSpanContext sp ctx++{-# INLINE mkCounter #-}+mkCounter :: MonadIO m => MI.InstrumentName -> m MI.Counter+mkCounter name = do+ inst <- MI.Counter name <$> I.nextInstrumentId+ I.traceBuilder $ I.builder_declareInstrument inst+ return inst++{-# INLINE mkUpDownCounter #-}+mkUpDownCounter :: MonadIO m => MI.InstrumentName -> m MI.UpDownCounter+mkUpDownCounter name = do+ inst <- MI.UpDownCounter name <$> I.nextInstrumentId+ I.traceBuilder $ I.builder_declareInstrument inst+ return inst++{-# INLINE mkValueRecorder #-}+mkValueRecorder :: MonadIO m => MI.InstrumentName -> m MI.ValueRecorder+mkValueRecorder name = do+ inst <- MI.ValueRecorder name <$> I.nextInstrumentId+ I.traceBuilder $ I.builder_declareInstrument inst+ return inst++{-# INLINE mkSumObserver #-}+mkSumObserver :: MonadIO m => MI.InstrumentName -> m MI.SumObserver+mkSumObserver name = do+ inst <- MI.SumObserver name <$> I.nextInstrumentId+ I.traceBuilder $ I.builder_declareInstrument inst+ return inst++{-# INLINE mkUpDownSumObserver #-}+mkUpDownSumObserver :: MonadIO m => MI.InstrumentName -> m MI.UpDownSumObserver+mkUpDownSumObserver name = do+ inst <- MI.UpDownSumObserver name <$> I.nextInstrumentId+ I.traceBuilder $ I.builder_declareInstrument inst+ return inst++{-# INLINE mkValueObserver #-}+mkValueObserver :: MonadIO m => MI.InstrumentName -> m MI.ValueObserver+mkValueObserver name = do+ inst <- MI.ValueObserver name <$> I.nextInstrumentId+ I.traceBuilder $ I.builder_declareInstrument inst+ return inst++-- | Take a measurement for a synchronous, additive instrument ('Counter', 'UpDownCounter')+{-# INLINE add #-}+add :: MonadIO m => MI.Instrument 'MI.Synchronous 'MI.Additive m' -> Int -> m ()+add i v = I.traceBuilder $ I.builder_captureMetric (MI.instrumentId i) v++-- | Take a measurement for a synchronous, non-additive instrument ('ValueRecorder')+{-# INLINE record #-}+record :: MonadIO m => MI.Instrument 'MI.Synchronous 'MI.NonAdditive m' -> Int -> m ()+record i v = I.traceBuilder $ I.builder_captureMetric (MI.instrumentId i) v++-- | Take a measurement for an asynchronous instrument ('SumObserver', 'UpDownSumObserver', 'ValueObserver')+{-# INLINE observe #-}+observe :: MonadIO m => MI.Instrument 'MI.Asynchronous a m' -> Int -> m ()+observe i v = I.traceBuilder $ I.builder_captureMetric (MI.instrumentId i) v
src/OpenTelemetry/Eventlog_Internal.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE GADTs #-} module OpenTelemetry.Eventlog_Internal where @@ -15,7 +16,9 @@ import Data.Word (Word64, Word8) import Debug.Trace.Binary import OpenTelemetry.SpanContext+import OpenTelemetry.Metrics_Internal import Prelude hiding (span)+import Data.Int -- This is not a Span Id in terms of OpenTelemetry. -- It's unique only in scope of one process, not globally.@@ -27,7 +30,7 @@ newtype MsgType = MsgType Word8 deriving (Show) -pattern BEGIN_SPAN, END_SPAN, TAG, EVENT, SET_PARENT_CONTEXT, SET_TRACE_ID, SET_SPAN_ID :: MsgType+pattern BEGIN_SPAN, END_SPAN, TAG, EVENT, SET_PARENT_CONTEXT, SET_TRACE_ID, SET_SPAN_ID, DECLARE_INSTRUMENT, METRIC_CAPTURE :: MsgType pattern BEGIN_SPAN = MsgType 1 pattern END_SPAN = MsgType 2 pattern TAG = MsgType 3@@ -35,6 +38,8 @@ pattern SET_PARENT_CONTEXT = MsgType 5 pattern SET_TRACE_ID = MsgType 6 pattern SET_SPAN_ID = MsgType 7+pattern DECLARE_INSTRUMENT = MsgType 8+pattern METRIC_CAPTURE = MsgType 9 {-# INLINE maxMsgLen #-} maxMsgLen :: Int@@ -70,6 +75,10 @@ nextLocalSpan :: MonadIO m => m SpanInFlight nextLocalSpan = liftIO $ (SpanInFlight . fromIntegral . hashUnique) <$> newUnique +{-# INLINE nextInstrumentId #-}+nextInstrumentId :: MonadIO m => m InstrumentId+nextInstrumentId = liftIO $ (fromIntegral . hashUnique) <$> newUnique+ {-# INLINE builder_beginSpan #-} builder_beginSpan :: SpanInFlight -> BS.ByteString -> Builder builder_beginSpan (SpanInFlight u) operation =@@ -107,6 +116,39 @@ builder_setSpanId :: SpanInFlight -> SpanId -> Builder builder_setSpanId (SpanInFlight u) (SId sid) = header SET_SPAN_ID <> word64LE u <> word64LE sid +{-# INLINE builder_declareInstrument #-}+builder_declareInstrument :: Instrument s a m -> Builder+builder_declareInstrument instrument =+ header DECLARE_INSTRUMENT <>+ int8 (instrumentTag instrument) <>+ word64LE (instrumentId instrument) <>+ byteString (instrumentName instrument)++{-# INLINE builder_captureMetric #-}+builder_captureMetric :: InstrumentId -> Int -> Builder+builder_captureMetric iId v =+ header METRIC_CAPTURE <>+ word64LE iId <>+ int64LE (fromIntegral v)+ {-# INLINE traceBuilder #-} traceBuilder :: MonadIO m => Builder -> m () traceBuilder = liftIO . traceBinaryEventIO . LBS.toStrict . toLazyByteString++{-# INLINE instrumentTag #-}+instrumentTag :: Instrument s a m -> Int8+instrumentTag Counter{} = 1+instrumentTag UpDownCounter{} = 2+instrumentTag ValueRecorder{} = 3+instrumentTag SumObserver{} = 4+instrumentTag UpDownSumObserver{} = 5+instrumentTag ValueObserver{} = 6++{-# INLINE instrumentTagStr #-}+instrumentTagStr :: Instrument s a m -> String+instrumentTagStr Counter{} = "Counter"+instrumentTagStr UpDownCounter{} = "UpDownCounter"+instrumentTagStr ValueRecorder{} = "ValueRecorder"+instrumentTagStr SumObserver{} = "SumObserver"+instrumentTagStr UpDownSumObserver{} = "UpDownSumObserver"+instrumentTagStr ValueObserver{} = "ValueObserver"
− src/OpenTelemetry/Exporter.hs
@@ -1,15 +0,0 @@-module OpenTelemetry.Exporter where--data ExportResult- = ExportSuccess- | ExportFailedRetryable- | ExportFailedNotRetryable- deriving (Show, Eq)--data Exporter thing = Exporter- { export :: [thing] -> IO ExportResult,- shutdown :: IO ()- }--noopExporter :: Exporter whatever-noopExporter = Exporter (const (pure ExportFailedNotRetryable)) (pure ())
+ src/OpenTelemetry/Metrics_Internal.hs view
@@ -0,0 +1,134 @@+{-|++This is an internal module. The public interface is re-exported by "OpenTelemetry.Eventlog"++This module implements the instruments of the metrics portion of the+OpenTelemetry API. It is reexported by "OpenTelemetry.Eventlog" and should be+used by importing that.++The way to use the 'Instrument' type is throught the 'add', 'record' or+'observe' functions (depending on the instrument type) which capture metrics on+a given instrument.++Usage:++@+import OpenTelemetry.Eventlog++aCounter :: Counter+aCounter = Counter "myCounter"++anObserver :: ValueObserver+anObserver = ValueObserver "myObserver"++main :: IO ()+main = do+ add aCounter 3+ record anObserver 40+@++-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}++module OpenTelemetry.Metrics_Internal+ ( Instrument(..)+ , SomeInstrument(..)+ -- * Synonyms for specific types of Instrument+ , Counter+ , UpDownCounter+ , ValueRecorder+ , SumObserver+ , UpDownSumObserver+ , ValueObserver+ -- * Used for indexing Instrument. All possible combinations are covered+ , Synchronicity(..)+ , Additivity(..)+ , Monotonicity(..)+ , InstrumentName+ , InstrumentId+ , instrumentName+ , instrumentId+ ) where++import Data.Hashable (Hashable(..))+import Data.ByteString as BS+import Data.Word++data Synchronicity = Synchronous | Asynchronous+data Additivity = Additive | NonAdditive+data Monotonicity = Monotonic | NonMonotonic++type InstrumentName = BS.ByteString+type InstrumentId = Word64++type Counter = Instrument 'Synchronous 'Additive 'Monotonic+type UpDownCounter = Instrument 'Synchronous 'Additive 'NonMonotonic+type ValueRecorder = Instrument 'Synchronous 'NonAdditive 'NonMonotonic+type SumObserver = Instrument 'Asynchronous 'Additive 'Monotonic+type UpDownSumObserver = Instrument 'Asynchronous 'Additive 'NonMonotonic+type ValueObserver = Instrument 'Asynchronous 'NonAdditive 'NonMonotonic++-- TODO: Support tags++-- | An OpenTelemetry instrument as defined in the OpenTelemetry Metrics API+-- (<https://github.com/open-telemetry/opentelemetry-specification/blob/master/specification/metrics/api.md>)+data Instrument (s :: Synchronicity) (a :: Additivity) (m :: Monotonicity) where+ Counter :: InstrumentName -> InstrumentId -> Counter+ UpDownCounter :: InstrumentName -> InstrumentId -> UpDownCounter+ ValueRecorder :: InstrumentName -> InstrumentId -> ValueRecorder+ SumObserver :: InstrumentName -> InstrumentId -> SumObserver+ UpDownSumObserver :: InstrumentName -> InstrumentId -> UpDownSumObserver+ ValueObserver :: InstrumentName -> InstrumentId -> ValueObserver++-- | Existential wrapper for 'Instrument'. Use when the exact type of Instrument does not matter.+data SomeInstrument = forall s a m. SomeInstrument (Instrument s a m)++instrumentName :: Instrument s a m -> InstrumentName+instrumentName (Counter n _) = n+instrumentName (UpDownCounter n _) = n+instrumentName (ValueRecorder n _) = n+instrumentName (SumObserver n _) = n+instrumentName (UpDownSumObserver n _) = n+instrumentName (ValueObserver n _) = n++instrumentId :: Instrument s a m -> InstrumentId+instrumentId (Counter _ i) = i+instrumentId (UpDownCounter _ i) = i+instrumentId (ValueRecorder _ i) = i+instrumentId (SumObserver _ i) = i+instrumentId (UpDownSumObserver _ i) = i+instrumentId (ValueObserver _ i) = i++deriving instance Show (Instrument s a m)+deriving instance Eq (Instrument s a m)++instance Show SomeInstrument where+ show (SomeInstrument i) = show i++instance Eq SomeInstrument where+ (SomeInstrument i1) == (SomeInstrument i2) = case (i1, i2) of+ (Counter s1 id1, Counter s2 id2) -> s1 == s2 && id1 == id2+ (UpDownCounter s1 id1, UpDownCounter s2 id2) -> s1 == s2 && id1 == id2+ (ValueRecorder s1 id1, ValueRecorder s2 id2) -> s1 == s2 && id1 == id2+ (SumObserver s1 id1, SumObserver s2 id2) -> s1 == s2 && id1 == id2+ (UpDownSumObserver s1 id1, UpDownSumObserver s2 id2) -> s1 == s2 && id1 == id2+ (ValueObserver s1 id1, ValueObserver s2 id2) -> s1 == s2 && id1 == id2+ (_, _) -> False++instance Hashable (Instrument s a m) where+ hashWithSalt s i = s `hashWithSalt` (constructorIdx i) `hashWithSalt` (instrumentName i)+ where+ constructorIdx :: Instrument s a m -> Int+ constructorIdx Counter{} = 0+ constructorIdx UpDownCounter{} = 1+ constructorIdx ValueRecorder{} = 2+ constructorIdx SumObserver{} = 3+ constructorIdx UpDownSumObserver{} = 4+ constructorIdx ValueObserver{} = 5++instance Hashable SomeInstrument where+ hashWithSalt s (SomeInstrument i) = hashWithSalt s i