opentelemetry 0.6.0 → 0.6.1
raw patch · 4 files changed
+263/−95 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- opentelemetry.cabal +3/−3
- src/OpenTelemetry/Eventlog.hs +121/−8
- src/OpenTelemetry/Eventlog_Internal.hs +62/−16
- src/OpenTelemetry/Metrics_Internal.hs +77/−68
opentelemetry.cabal view
@@ -2,7 +2,7 @@ name: opentelemetry description: The OpenTelemetry Haskell Client https://opentelemetry.io category: OpenTelemetry-version: 0.6.0+version: 0.6.1 license-file: LICENSE license: Apache-2.0 author: Dmitry Ivanov@@ -48,7 +48,7 @@ library import: options build-depends:- base >= 4.13 && < 5,+ base >= 4.12 && < 5, bytestring, ghc-trace-events >= 0.1.0.1, hashable,@@ -58,5 +58,5 @@ OpenTelemetry.SpanContext OpenTelemetry.Propagation OpenTelemetry.Eventlog- OpenTelemetry.Eventlog_Internal OpenTelemetry.Metrics_Internal+ OpenTelemetry.Eventlog_Internal
src/OpenTelemetry/Eventlog.hs view
@@ -1,6 +1,7 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} module OpenTelemetry.Eventlog@@ -15,6 +16,7 @@ addEvent, setParentSpanContext, SpanInFlight (..),+ -- * Metrics mkCounter, mkUpDownCounter,@@ -26,21 +28,22 @@ record, observe, MI.Instrument,- MI.SomeInstrument(..),+ MI.SomeInstrument (..), MI.Counter, MI.UpDownCounter, MI.ValueRecorder, MI.SumObserver, MI.UpDownSumObserver, MI.ValueObserver,- MI.Synchronicity(..),- MI.Additivity(..),- MI.Monotonicity(..),+ MI.Synchronicity (..),+ MI.Additivity (..),+ MI.Monotonicity (..), MI.InstrumentName, MI.InstrumentId, MI.instrumentName,- MI.instrumentId- ) where+ MI.instrumentId,+ )+where import Control.Monad.Catch import Control.Monad.IO.Class@@ -48,9 +51,117 @@ import qualified Data.ByteString.Char8 as BS8 import OpenTelemetry.Eventlog_Internal (SpanInFlight (..)) import qualified OpenTelemetry.Eventlog_Internal as I-import OpenTelemetry.SpanContext import qualified OpenTelemetry.Metrics_Internal as MI+import OpenTelemetry.SpanContext+import Prelude hiding (span) +#if __GLASGOW_HASKELL__ < 808++import Data.Unique+import Debug.Trace+import OpenTelemetry.Metrics_Internal++beginSpan :: MonadIO m => String -> m SpanInFlight+beginSpan operation = do+ u64 <- fromIntegral . hashUnique <$> liftIO newUnique+ liftIO $ traceEventIO (I.beginSpan' (SpanInFlight u64) operation)+ pure $ SpanInFlight u64++endSpan :: MonadIO m => SpanInFlight -> m ()+endSpan = liftIO . traceEventIO . I.endSpan'++setTag :: MonadIO m => SpanInFlight -> String -> BS.ByteString -> m ()+setTag sp k v = liftIO . traceEventIO $ I.setTag' sp k v++addEvent :: MonadIO m => SpanInFlight -> String -> BS.ByteString -> m ()+addEvent sp k v = liftIO . traceEventIO $ I.addEvent' sp k v++setParentSpanContext :: MonadIO m => SpanInFlight -> SpanContext -> m ()+setParentSpanContext sp ctx = liftIO . traceEventIO $ I.setParentSpanContext' sp ctx++setTraceId :: MonadIO m => SpanInFlight -> TraceId -> m ()+setTraceId sp tid = liftIO . traceEventIO $ I.setTraceId' sp tid++setSpanId :: MonadIO m => SpanInFlight -> SpanId -> m ()+setSpanId sp sid = liftIO . traceEventIO $ I.setSpanId' sp sid++createInstrument :: MonadIO io => MI.Instrument s a m -> io ()+createInstrument = liftIO . traceEventIO . I.createInstrument'++writeMetric :: MonadIO io => MI.Instrument s a m -> Int -> io ()+writeMetric i v = liftIO $ traceEventIO $ I.writeMetric' (instrumentId i) v++mkCounter :: MonadIO m => MI.InstrumentName -> m MI.Counter+mkCounter name = do+ inst <- MI.Counter name <$> I.nextInstrumentId+ createInstrument inst+ return inst++mkUpDownCounter :: MonadIO m => MI.InstrumentName -> m MI.UpDownCounter+mkUpDownCounter name = do+ inst <- MI.UpDownCounter name <$> I.nextInstrumentId+ createInstrument inst+ return inst++mkValueRecorder :: MonadIO m => MI.InstrumentName -> m MI.ValueRecorder+mkValueRecorder name = do+ inst <- MI.ValueRecorder name <$> I.nextInstrumentId+ createInstrument inst+ return inst++mkSumObserver :: MonadIO m => MI.InstrumentName -> m MI.SumObserver+mkSumObserver name = do+ inst <- MI.SumObserver name <$> I.nextInstrumentId+ createInstrument inst+ return inst++mkUpDownSumObserver :: MonadIO m => MI.InstrumentName -> m MI.UpDownSumObserver+mkUpDownSumObserver name = do+ inst <- MI.UpDownSumObserver name <$> I.nextInstrumentId+ createInstrument inst+ return inst++mkValueObserver :: MonadIO m => MI.InstrumentName -> m MI.ValueObserver+mkValueObserver name = do+ inst <- MI.ValueObserver name <$> I.nextInstrumentId+ createInstrument inst+ return inst++-- | Take a measurement for a synchronous, additive instrument ('Counter', 'UpDowncounter')+add :: MonadIO io => MI.Instrument 'MI.Synchronous 'MI.Additive m' -> Int -> io ()+add = writeMetric++-- | Take a measurement for a synchronous, non-additive instrument ('ValueRecorder')+record :: MonadIO io => MI.Instrument 'MI.Synchronous 'MI.NonAdditive m' -> Int -> io ()+record = writeMetric++-- | Take a measurement for an asynchronous instrument ('SumObserver', 'UpDownSumObserver', 'ValueObserver')+observe :: MonadIO io => MI.Instrument 'MI.Asynchronous a m' -> Int -> io ()+observe = writeMetric++withSpan :: forall m a. (MonadIO m, MonadMask m) => String -> (SpanInFlight -> m a) -> m a+withSpan operation action =+ fst+ <$> generalBracket+ (liftIO $ beginSpan operation)+ ( \span exitcase -> liftIO $ do+ case exitcase of+ ExitCaseSuccess _ -> pure ()+ ExitCaseException e -> do+ setTag span "error" "true"+ setTag span "error.message" (BS8.pack $ show e)+ ExitCaseAbort -> do+ setTag span "error" "true"+ setTag span "error.message" "abort"+ liftIO $ endSpan span+ )+ action++withSpan_ :: (MonadIO m, MonadMask m) => String -> m a -> m a+withSpan_ operation action = withSpan operation (const action)++#else+ {-# INLINE withSpan #-} withSpan :: forall m a.@@ -166,3 +277,5 @@ {-# 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++#endif
src/OpenTelemetry/Eventlog_Internal.hs view
@@ -1,7 +1,8 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE GADTs #-} module OpenTelemetry.Eventlog_Internal where @@ -9,16 +10,23 @@ import Data.Bits import qualified Data.ByteString as BS import Data.ByteString.Builder+import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as LBS import Data.Char import Data.Hashable+#if __GLASGOW_HASKELL__ < 808+import Debug.Trace.ByteString+#else+import Debug.Trace.Binary+#endif++import Data.Int import Data.Unique import Data.Word (Word64, Word8)-import Debug.Trace.Binary+import OpenTelemetry.Metrics_Internal as MI import OpenTelemetry.SpanContext-import OpenTelemetry.Metrics_Internal+import Text.Printf 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.@@ -79,6 +87,8 @@ nextInstrumentId :: MonadIO m => m InstrumentId nextInstrumentId = liftIO $ (fromIntegral . hashUnique) <$> newUnique +-- These functions all depend on the binary eventlog to be useful.+#if __GLASGOW_HASKELL__ >= 808 {-# INLINE builder_beginSpan #-} builder_beginSpan :: SpanInFlight -> BS.ByteString -> Builder builder_beginSpan (SpanInFlight u) operation =@@ -134,21 +144,57 @@ {-# INLINE traceBuilder #-} traceBuilder :: MonadIO m => Builder -> m () traceBuilder = liftIO . traceBinaryEventIO . LBS.toStrict . toLazyByteString+#endif +-- For use with human-readable eventlog++beginSpan' :: SpanInFlight -> String -> String+beginSpan' (SpanInFlight u64) operation =+ printf "ot2 begin span %d %s" u64 operation++endSpan' :: SpanInFlight -> String+endSpan' (SpanInFlight u64) = printf "ot2 end span %d" u64++setTag' :: SpanInFlight -> String -> BS8.ByteString -> String+setTag' (SpanInFlight u64) k v =+ printf "ot2 set tag %d %s %s" u64 k (BS8.unpack v)++addEvent' :: SpanInFlight -> String -> BS8.ByteString -> String+addEvent' (SpanInFlight u64) k v =+ printf "ot2 add event %d %s %s" u64 k (BS8.unpack v)++setParentSpanContext' :: SpanInFlight -> SpanContext -> String+setParentSpanContext' (SpanInFlight u64) (SpanContext (SId sid) (TId tid)) =+ (printf "ot2 set parent %d %016x %016x" u64 tid sid)++setTraceId' :: SpanInFlight -> TraceId -> String+setTraceId' (SpanInFlight u64) (TId tid) =+ printf "ot2 set traceid %d %016x" u64 tid++setSpanId' :: SpanInFlight -> SpanId -> String+setSpanId' (SpanInFlight u64) (SId sid) =+ printf "ot2 set spanid %d %016x" u64 sid++createInstrument' :: MI.Instrument s a m -> String+createInstrument' i = printf "ot2 metric create %s %016x %s" (instrumentTagStr i) (instrumentId i) (BS8.unpack $ instrumentName i)++writeMetric' :: InstrumentId -> Int -> String+writeMetric' iid v = printf "ot2 metric capture %016x %s" iid (show v)+ {-# 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+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"+instrumentTagStr Counter {} = "Counter"+instrumentTagStr UpDownCounter {} = "UpDownCounter"+instrumentTagStr ValueRecorder {} = "ValueRecorder"+instrumentTagStr SumObserver {} = "SumObserver"+instrumentTagStr UpDownSumObserver {} = "UpDownSumObserver"+instrumentTagStr ValueObserver {} = "ValueObserver"
src/OpenTelemetry/Metrics_Internal.hs view
@@ -1,88 +1,96 @@-{-|--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 KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} +-- |+--+-- 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+-- @ 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+ ( Instrument (..),+ SomeInstrument (..), -import Data.Hashable (Hashable(..))+ -- * 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.ByteString as BS+import Data.Hashable (Hashable (..)) 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+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+ Counter :: InstrumentName -> InstrumentId -> Counter+ UpDownCounter :: InstrumentName -> InstrumentId -> UpDownCounter+ ValueRecorder :: InstrumentName -> InstrumentId -> ValueRecorder+ SumObserver :: InstrumentName -> InstrumentId -> SumObserver UpDownSumObserver :: InstrumentName -> InstrumentId -> UpDownSumObserver- ValueObserver :: InstrumentName -> InstrumentId -> ValueObserver+ 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)@@ -104,6 +112,7 @@ instrumentId (ValueObserver _ i) = i deriving instance Show (Instrument s a m)+ deriving instance Eq (Instrument s a m) instance Show SomeInstrument where@@ -123,12 +132,12 @@ 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+ 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