diff --git a/api/hs-opentelemetry-api.cabal b/api/hs-opentelemetry-api.cabal index 52630bc7..7ebd3bd7 100644 --- a/api/hs-opentelemetry-api.cabal +++ b/api/hs-opentelemetry-api.cabal @@ -27,11 +27,10 @@ source-repository head library exposed-modules: - OpenTelemetry.Attribute - OpenTelemetry.Attribute.Attribute - OpenTelemetry.Attribute.AttributeCollection - OpenTelemetry.Attribute.Attributes - OpenTelemetry.Attribute.Key + OpenTelemetry.Attributes + OpenTelemetry.Attributes.Attribute + OpenTelemetry.Attributes.Key + OpenTelemetry.Attributes.Map OpenTelemetry.Baggage OpenTelemetry.Common OpenTelemetry.Context diff --git a/api/src/OpenTelemetry/Attribute.hs b/api/src/OpenTelemetry/Attribute.hs deleted file mode 100644 index 351c7711..00000000 --- a/api/src/OpenTelemetry/Attribute.hs +++ /dev/null @@ -1,27 +0,0 @@ -module OpenTelemetry.Attribute ( - AttributeCollection, - emptyAttributes, - addAttribute, - addAttributes, - lookupAttribute, - Attribute (..), - IsAttribute (..), - PrimitiveAttribute (..), - IsPrimitiveAttribute (..), - Key (..), - Attributes, - - -- * Attribute limits - AttributeLimits (..), - defaultAttributeLimits, - - -- * Unsafe utilities - unsafeAttributesFromListIgnoringLimits, - unsafeMergeAttributesIgnoringLimits, -) where - -import OpenTelemetry.Attribute.Attribute -import OpenTelemetry.Attribute.AttributeCollection -import OpenTelemetry.Attribute.Attributes (Attributes) -import OpenTelemetry.Attribute.Key - diff --git a/api/src/OpenTelemetry/Attribute/AttributeCollection.hs b/api/src/OpenTelemetry/Attribute/AttributeCollection.hs deleted file mode 100644 index 0ba51e76..00000000 --- a/api/src/OpenTelemetry/Attribute/AttributeCollection.hs +++ /dev/null @@ -1,169 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE StrictData #-} - -{- | -Module : OpenTelemetry.AttributeCollection -Copyright : (c) Ian Duncan, 2021 -License : BSD-3 -Description : Key-value pair metadata used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's -Maintainer : Ian Duncan -Stability : experimental -Portability : non-portable (GHC extensions) - -An Attribute is a key-value pair, which MUST have the following properties: - -- The attribute key MUST be a non-@null@ and non-empty string. -- The attribute value is either: - - - A primitive type: string, boolean, double precision floating point (IEEE 754-1985) or signed 64 bit integer. - - An array of primitive type values. The array MUST be homogeneous, i.e., it MUST NOT contain values of different types. For protocols that do not natively support array values such values SHOULD be represented as JSON strings. - -Attribute values expressing a numerical value of zero, an empty string, or an empty array are considered meaningful and MUST be stored and passed on to processors \/ exporters. - -Specification: https://opentelemetry.io/docs/specs/otel/common/ --} -module OpenTelemetry.Attribute.AttributeCollection ( - AttributeCollection, - emptyAttributes, - addAttribute, - addAttributes, - lookupAttribute, - attributes, - count, - - -- * Attribute limits - AttributeLimits (..), - defaultAttributeLimits, - - -- * Unsafe utilities - unsafeAttributesFromListIgnoringLimits, - unsafeMergeAttributesIgnoringLimits, -) where - -import Data.Data (Data) -import Data.Default.Class (Default (def)) -import Data.Hashable (Hashable) -import Data.Maybe (fromMaybe) -import qualified Data.Text as T -import GHC.Generics (Generic) -import OpenTelemetry.Attribute.Attribute (Attribute (AttributeArray, AttributeValue), IsAttribute (fromAttribute, toAttribute), PrimitiveAttribute (TextAttribute)) -import OpenTelemetry.Attribute.Attributes (Attributes) -import qualified OpenTelemetry.Attribute.Attributes as A -import OpenTelemetry.Attribute.Key (Key) -import Prelude hiding (lookup) - - -{- | Default attribute limits used in the global attribute limit configuration if no environment variables are set. - -Values: - -- 'attributeCountLimit': @Just 128@ -- 'attributeLengthLimit': Infinity or @Nothing@ --} -defaultAttributeLimits :: AttributeLimits -defaultAttributeLimits = - AttributeLimits - { attributeCountLimit = Just 128 - , attributeLengthLimit = Nothing - } - - -data AttributeCollection = AttributeCollection - { attributes :: !Attributes - , attributesCount :: {-# UNPACK #-} !Int - , attributesDropped :: {-# UNPACK #-} !Int - } - deriving stock (Show, Eq) - - -instance Default AttributeCollection where - def = emptyAttributes - - -emptyAttributes :: AttributeCollection -emptyAttributes = AttributeCollection mempty 0 0 - - -addAttribute :: (IsAttribute a) => AttributeLimits -> AttributeCollection -> Key a -> a -> AttributeCollection -addAttribute AttributeLimits {..} AttributeCollection {..} k !v = case attributeCountLimit of - Nothing -> AttributeCollection newAttrs newCount attributesDropped - Just limit_ -> - if newCount > limit_ - then AttributeCollection attributes attributesCount (attributesDropped + 1) - else AttributeCollection newAttrs newCount attributesDropped - where - newAttrs = A.insert k (maybe id limitLengths attributeCountLimit v) attributes - newCount = A.size newAttrs -{-# INLINE addAttribute #-} - - -addAttributes :: AttributeLimits -> AttributeCollection -> Attributes -> AttributeCollection -addAttributes AttributeLimits {..} AttributeCollection {..} attrs = case attributeCountLimit of - Nothing -> AttributeCollection newAttrs newCount attributesDropped - Just limit_ -> - if newCount > limit_ - then AttributeCollection attributes attributesCount (attributesDropped + A.size attrs) - else AttributeCollection newAttrs newCount attributesDropped - where - newAttrs = A.union attributes attrs - newCount = A.size newAttrs -{-# INLINE addAttributes #-} - - -limitPrimAttr :: Int -> PrimitiveAttribute -> PrimitiveAttribute -limitPrimAttr limit (TextAttribute t) = TextAttribute (T.take limit t) -limitPrimAttr _ attr = attr - - -limitLengths :: IsAttribute a => Int -> a -> a -limitLengths limit a = - fromMaybe a $ - fromAttribute $ - case toAttribute a of - AttributeValue val -> AttributeValue $ limitPrimAttr limit val - AttributeArray arr -> AttributeArray $ fmap (limitPrimAttr limit) arr - - -count :: AttributeCollection -> Int -count = attributesCount - - -lookupAttribute :: AttributeCollection -> Key Attribute -> Maybe Attribute -lookupAttribute AttributeCollection {..} k = A.lookupAttribute k attributes - - -{- | It is possible when adding attributes that a programming error might cause too many - attributes to be added to an event. Thus, 'AttributeCollection' use the limits set here as a safeguard - against excessive memory consumption. --} -data AttributeLimits = AttributeLimits - { attributeCountLimit :: Maybe Int - -- ^ The number of unique attributes that may be added to an 'AttributeCollection' structure before they are attributesDropped. - , attributeLengthLimit :: Maybe Int - -- ^ The maximum length of string attributes that may be set. Longer-length string values will be truncated to the - -- specified amount. - } - deriving stock (Read, Show, Eq, Ord, Data, Generic) - deriving anyclass (Hashable) - - -instance Default AttributeLimits where - def = defaultAttributeLimits - - -unsafeMergeAttributesIgnoringLimits :: AttributeCollection -> AttributeCollection -> AttributeCollection -unsafeMergeAttributesIgnoringLimits (AttributeCollection l lc ld) (AttributeCollection r rc rd) = AttributeCollection (l <> r) (lc + rc) (ld + rd) - - -unsafeAttributesFromListIgnoringLimits :: IsAttribute a => [(Key a, a)] -> AttributeCollection -unsafeAttributesFromListIgnoringLimits l = AttributeCollection hm c 0 - where - hm = A.fromList l - c = A.size hm diff --git a/api/src/OpenTelemetry/Attribute/Attributes.hs b/api/src/OpenTelemetry/Attribute/Attributes.hs deleted file mode 100644 index 04d37eb1..00000000 --- a/api/src/OpenTelemetry/Attribute/Attributes.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeFamilies #-} - -{- | -Module : OpenTelemetry.AttributeCollection -Copyright : (c) Kazuki Okamoto (岡本和樹), 2023 -License : BSD-3 -Description : Key-value pair metadata used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's -Maintainer : Kazuki Okamoto (岡本和樹) -Stability : experimental -Portability : non-portable (GHC extensions) --} -module OpenTelemetry.Attribute.Attributes ( - Attributes (..), - empty, - fromList, - toList, - insert, - union, - unions, - lookup, - lookupAttribute, - size, -) where - -import Data.Bifunctor (Bifunctor (first)) -import Data.Default.Class (Default (def)) -import qualified Data.HashMap.Strict as H -import Data.Hashable (Hashable) -import Data.Text (Text) -import qualified GHC.Exts as E -import GHC.Generics (Generic) -import OpenTelemetry.Attribute.Attribute ( - Attribute, - IsAttribute (..), - ) -import OpenTelemetry.Attribute.Key ( - Key (Key), - ) -import Prelude hiding (lookup, map) - - -newtype Attributes = Attributes - {contents :: H.HashMap Text Attribute} - deriving stock (Show, Read, Eq, Ord, Generic) - deriving newtype (Semigroup, Monoid) - deriving anyclass (Hashable) - - -instance Default Attributes where - def = mempty - - -instance E.IsList Attributes where - type Item Attributes = (Key Attribute, Attribute) - fromList = fromList - toList = toList - - -fromList :: IsAttribute a => [(Key a, a)] -> Attributes -fromList = Attributes . H.fromList . fmap (\(Key k, v) -> (k, toAttribute v)) - - -toList :: Attributes -> [(Key Attribute, Attribute)] -toList = fmap (first Key) . H.toList . contents - - -empty :: Attributes -empty = mempty - - -lift :: (H.HashMap Text Attribute -> c) -> Attributes -> c -lift f = f . contents - - -lift2 :: (H.HashMap Text Attribute -> H.HashMap Text Attribute -> c) -> Attributes -> Attributes -> c -lift2 f a b = f (contents a) (contents b) - - -map :: (H.HashMap Text Attribute -> H.HashMap Text Attribute) -> Attributes -> Attributes -map f = lift $ Attributes . f - - -insert :: (IsAttribute a) => Key a -> a -> Attributes -> Attributes -insert (Key !k) !v = - map $ H.insert k (toAttribute v) - - -union :: Attributes -> Attributes -> Attributes -union a b = Attributes $ lift2 H.union a b - - -unions :: [Attributes] -> Attributes -unions = Attributes . H.unions . fmap contents - - -lookup :: IsAttribute a => Key a -> Attributes -> Maybe a -lookup (Key k) Attributes {..} = H.lookup k contents >>= fromAttribute - - -lookupAttribute :: Key Attribute -> Attributes -> Maybe Attribute -lookupAttribute (Key k) Attributes {..} = H.lookup k contents - - -size :: Attributes -> Int -size = lift H.size diff --git a/api/src/OpenTelemetry/Attributes.hs b/api/src/OpenTelemetry/Attributes.hs new file mode 100644 index 00000000..195de929 --- /dev/null +++ b/api/src/OpenTelemetry/Attributes.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE StrictData #-} + +{- | + Module : OpenTelemetry.Attributes + Copyright : (c) Ian Duncan, 2021 + License : BSD-3 + Description : Key-value pair metadata used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's + Maintainer : Ian Duncan + Stability : experimental + Portability : non-portable (GHC extensions) + + An Attribute is a key-value pair, which MUST have the following properties: + + - The attribute key MUST be a non-@null@ and non-empty string. + - The attribute value is either: + + - A primitive type: string, boolean, double precision floating point (IEEE 754-1985) or signed 64 bit integer. + - An array of primitive type values. The array MUST be homogeneous, i.e., it MUST NOT contain values of different types. For protocols that do not natively support array values such values SHOULD be represented as JSON strings. + + Attribute values expressing a numerical value of zero, an empty string, or an empty array are considered meaningful and MUST be stored and passed on to processors \/ exporters. + + Specification: https://opentelemetry.io/docs/specs/otel/common/ +-} +module OpenTelemetry.Attributes ( + Attributes, + emptyAttributes, + addAttribute, + addAttributeByKey, + addAttributes, + lookupAttribute, + lookupAttributeByKey, + getAttributes, + getCount, + Attribute (..), + ToAttribute (..), + FromAttribute (..), + PrimitiveAttribute (..), + ToPrimitiveAttribute (..), + FromPrimitiveAttribute (..), + Key (..), + module Key, + + -- * Attribute limits + AttributeLimits (..), + defaultAttributeLimits, + + -- * Unsafe utilities + unsafeAttributesFromListIgnoringLimits, + unsafeMergeAttributesIgnoringLimits, +) where + +import Data.Data (Data) +import Data.Default.Class (Default (def)) +import qualified Data.HashMap.Strict as H +import Data.Hashable (Hashable) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import OpenTelemetry.Attributes.Attribute (Attribute (..), FromAttribute (..), FromPrimitiveAttribute (..), PrimitiveAttribute (..), ToAttribute (..), ToPrimitiveAttribute (..)) +import OpenTelemetry.Attributes.Key as Key +import qualified OpenTelemetry.Attributes.Map as A +import Prelude hiding (lookup) + + +{- | Default attribute limits used in the global attribute limit configuration if no environment variables are set. + + Values: + + - 'attributeCountLimit': @Just 128@ + - 'attributeLengthLimit': Infinity or @Nothing@ +-} +defaultAttributeLimits :: AttributeLimits +defaultAttributeLimits = + AttributeLimits + { attributeCountLimit = Just 128 + , attributeLengthLimit = Nothing + } + + +data Attributes = Attributes + { attributes :: !(H.HashMap Text Attribute) + , attributesCount :: {-# UNPACK #-} !Int + , attributesDropped :: {-# UNPACK #-} !Int + } + deriving stock (Show, Eq) + + +instance Default Attributes where + def = emptyAttributes + + +emptyAttributes :: Attributes +emptyAttributes = Attributes mempty 0 0 + + +addAttribute :: (ToAttribute a) => AttributeLimits -> Attributes -> Text -> a -> Attributes +addAttribute AttributeLimits {..} Attributes {..} k !v = case attributeCountLimit of + Nothing -> Attributes newAttrs newCount attributesDropped + Just limit_ -> + if newCount > limit_ + then Attributes attributes attributesCount (attributesDropped + 1) + else Attributes newAttrs newCount attributesDropped + where + newAttrs = H.insert k (maybe id limitLengths attributeCountLimit $ toAttribute v) attributes + newCount = H.size newAttrs +{-# INLINE addAttribute #-} + + +addAttributeByKey :: (ToAttribute a) => AttributeLimits -> Attributes -> Key a -> a -> Attributes +addAttributeByKey limits attrs (Key k) !v = addAttribute limits attrs k v + + +addAttributes :: AttributeLimits -> Attributes -> H.HashMap Text Attribute -> Attributes +addAttributes AttributeLimits {..} Attributes {..} attrs = case attributeCountLimit of + Nothing -> Attributes newAttrs newCount attributesDropped + Just limit_ -> + if newCount > limit_ + then Attributes attributes attributesCount (attributesDropped + H.size attrs) + else Attributes newAttrs newCount attributesDropped + where + newAttrs = H.union attributes attrs + newCount = H.size newAttrs +{-# INLINE addAttributes #-} + + +limitPrimAttr :: Int -> PrimitiveAttribute -> PrimitiveAttribute +limitPrimAttr limit (TextAttribute t) = TextAttribute (T.take limit t) +limitPrimAttr _ attr = attr + + +limitLengths :: Int -> Attribute -> Attribute +limitLengths limit (AttributeValue val) = AttributeValue $ limitPrimAttr limit val +limitLengths limit (AttributeArray arr) = AttributeArray $ fmap (limitPrimAttr limit) arr + + +getAttributes :: Attributes -> H.HashMap Text Attribute +getAttributes Attributes {..} = attributes + + +getCount :: Attributes -> Int +getCount Attributes {..} = attributesCount + + +lookupAttribute :: Attributes -> Text -> Maybe Attribute +lookupAttribute Attributes {..} k = H.lookup k attributes + + +lookupAttributeByKey :: FromAttribute a => Attributes -> Key a -> Maybe a +lookupAttributeByKey Attributes {..} k = A.lookupByKey k attributes + + +{- | It is possible when adding attributes that a programming error might cause too many + attributes to be added to an event. Thus, 'Attributes' use the limits set here as a safeguard + against excessive memory consumption. +-} +data AttributeLimits = AttributeLimits + { attributeCountLimit :: Maybe Int + -- ^ The number of unique attributes that may be added to an 'Attributes' structure before they are attributesDropped. + , attributeLengthLimit :: Maybe Int + -- ^ The maximum length of string attributes that may be set. Longer-length string values will be truncated to the + -- specified amount. + } + deriving stock (Read, Show, Eq, Ord, Data, Generic) + deriving anyclass (Hashable) + + +instance Default AttributeLimits where + def = defaultAttributeLimits + + +unsafeMergeAttributesIgnoringLimits :: Attributes -> Attributes -> Attributes +unsafeMergeAttributesIgnoringLimits (Attributes l lc ld) (Attributes r rc rd) = Attributes (l <> r) (lc + rc) (ld + rd) + + +unsafeAttributesFromListIgnoringLimits :: [(Text, Attribute)] -> Attributes +unsafeAttributesFromListIgnoringLimits l = Attributes hm c 0 + where + hm = H.fromList l + c = H.size hm diff --git a/api/src/OpenTelemetry/Attribute/Attribute.hs b/api/src/OpenTelemetry/Attributes/Attribute.hs similarity index 67% rename from api/src/OpenTelemetry/Attribute/Attribute.hs rename to api/src/OpenTelemetry/Attributes/Attribute.hs index 67511de2..f2a87123 100644 --- a/api/src/OpenTelemetry/Attribute/Attribute.hs +++ b/api/src/OpenTelemetry/Attributes/Attribute.hs @@ -11,7 +11,7 @@ {-# LANGUAGE TypeFamilies #-} {- | -Module : OpenTelemetry.Attribute +Module : OpenTelemetry.Attributes.Attribute Copyright : (c) Ian Duncan, 2021 License : BSD-3 Description : Key-value pair metadata used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's @@ -19,11 +19,13 @@ Maintainer : Ian Duncan Stability : experimental Portability : non-portable (GHC extensions) -} -module OpenTelemetry.Attribute.Attribute ( +module OpenTelemetry.Attributes.Attribute ( Attribute (..), - IsAttribute (..), + ToAttribute (..), + FromAttribute (..), PrimitiveAttribute (..), - IsPrimitiveAttribute (..), + ToPrimitiveAttribute (..), + FromPrimitiveAttribute (..), ) where import Data.Data (Data) @@ -37,8 +39,11 @@ import Prelude hiding (lookup, map) -- | Convert a Haskell value to a 'PrimitiveAttribute' value. -class IsPrimitiveAttribute a where +class ToPrimitiveAttribute a where toPrimitiveAttribute :: a -> PrimitiveAttribute + + +class FromPrimitiveAttribute a where fromPrimitiveAttribute :: PrimitiveAttribute -> Maybe a @@ -85,90 +90,135 @@ data PrimitiveAttribute {- | Convert a Haskell value to an 'Attribute' value. - For most values, you can define an instance of 'IsPrimitiveAttribute' and use the default 'toAttribute' implementation: + For most values, you can define an instance of 'ToAttribute' and use the default 'toAttribute' implementation: @ data Foo = Foo - instance IsPrimitiveAttribute Foo where + instance ToAttribute Foo where toPrimitiveAttribute Foo = TextAttribute "Foo" - instance IsAttribute foo + instance ToAttribute foo @ -} -class IsAttribute a where +class ToAttribute a where toAttribute :: a -> Attribute - default toAttribute :: (IsPrimitiveAttribute a) => a -> Attribute + default toAttribute :: (ToPrimitiveAttribute a) => a -> Attribute toAttribute = AttributeValue . toPrimitiveAttribute + + +class FromAttribute a where fromAttribute :: Attribute -> Maybe a - default fromAttribute :: (IsPrimitiveAttribute a) => Attribute -> Maybe a + default fromAttribute :: (FromPrimitiveAttribute a) => Attribute -> Maybe a fromAttribute (AttributeValue v) = fromPrimitiveAttribute v fromAttribute _ = Nothing -instance IsPrimitiveAttribute PrimitiveAttribute where +instance ToPrimitiveAttribute PrimitiveAttribute where toPrimitiveAttribute = id + + +instance FromPrimitiveAttribute PrimitiveAttribute where fromPrimitiveAttribute = Just -instance IsAttribute PrimitiveAttribute where +instance ToAttribute PrimitiveAttribute where toAttribute = AttributeValue + + +instance FromAttribute PrimitiveAttribute where fromAttribute (AttributeValue v) = Just v fromAttribute _ = Nothing -instance IsPrimitiveAttribute Text where +instance ToPrimitiveAttribute Text where toPrimitiveAttribute = TextAttribute + + +instance FromPrimitiveAttribute Text where fromPrimitiveAttribute (TextAttribute v) = Just v fromPrimitiveAttribute _ = Nothing -instance IsAttribute Text +instance ToAttribute Text + + +instance FromAttribute Text -instance IsPrimitiveAttribute Bool where +instance ToPrimitiveAttribute Bool where toPrimitiveAttribute = BoolAttribute + + +instance FromPrimitiveAttribute Bool where fromPrimitiveAttribute (BoolAttribute v) = Just v fromPrimitiveAttribute _ = Nothing -instance IsAttribute Bool +instance ToAttribute Bool + + +instance FromAttribute Bool -instance IsPrimitiveAttribute Double where +instance ToPrimitiveAttribute Double where toPrimitiveAttribute = DoubleAttribute + + +instance FromPrimitiveAttribute Double where fromPrimitiveAttribute (DoubleAttribute v) = Just v fromPrimitiveAttribute _ = Nothing -instance IsAttribute Double +instance ToAttribute Double + + +instance FromAttribute Double -instance IsPrimitiveAttribute Int64 where +instance ToPrimitiveAttribute Int64 where toPrimitiveAttribute = IntAttribute + + +instance FromPrimitiveAttribute Int64 where fromPrimitiveAttribute (IntAttribute v) = Just v fromPrimitiveAttribute _ = Nothing -instance IsAttribute Int64 +instance ToAttribute Int64 + + +instance FromAttribute Int64 -instance IsPrimitiveAttribute Int where +instance ToPrimitiveAttribute Int where toPrimitiveAttribute = IntAttribute . fromIntegral + + +instance FromPrimitiveAttribute Int where fromPrimitiveAttribute (IntAttribute v) = Just $ fromIntegral v fromPrimitiveAttribute _ = Nothing -instance IsAttribute Int +instance ToAttribute Int + + +instance FromAttribute Int -instance IsAttribute Attribute where +instance ToAttribute Attribute where toAttribute = id + + +instance FromAttribute Attribute where fromAttribute = Just -instance (IsPrimitiveAttribute a) => IsAttribute [a] where +instance (ToPrimitiveAttribute a) => ToAttribute [a] where toAttribute = AttributeArray . L.map toPrimitiveAttribute + + +instance (FromPrimitiveAttribute a) => FromAttribute [a] where fromAttribute (AttributeArray arr) = traverse fromPrimitiveAttribute arr fromAttribute _ = Nothing diff --git a/api/src/OpenTelemetry/Attribute/Key.hs b/api/src/OpenTelemetry/Attributes/Key.hs similarity index 99% rename from api/src/OpenTelemetry/Attribute/Key.hs rename to api/src/OpenTelemetry/Attributes/Key.hs index 27d66185..34e3cf04 100644 --- a/api/src/OpenTelemetry/Attribute/Key.hs +++ b/api/src/OpenTelemetry/Attributes/Key.hs @@ -2,7 +2,7 @@ {-# LANGUAGE DerivingStrategies #-} {- | -Module : OpenTelemetry.AttributeCollection +Module : OpenTelemetry.Attributes.Key Copyright : (c) Kazuki Okamoto (岡本和樹), 2023 License : BSD-3 Description : Key-value pair metadata used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's @@ -10,7 +10,7 @@ Maintainer : Kazuki Okamoto (岡本和樹) Stability : experimental Portability : non-portable (GHC extensions) -} -module OpenTelemetry.Attribute.Key ( +module OpenTelemetry.Attributes.Key ( Key (..), forget, @@ -269,7 +269,7 @@ import Data.String (IsString (..)) import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) -import OpenTelemetry.Attribute.Attribute (Attribute) +import OpenTelemetry.Attributes.Attribute (Attribute) {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} diff --git a/api/src/OpenTelemetry/Attributes/Map.hs b/api/src/OpenTelemetry/Attributes/Map.hs new file mode 100644 index 00000000..1ba6a9da --- /dev/null +++ b/api/src/OpenTelemetry/Attributes/Map.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TypeFamilies #-} + +{- | +Module : OpenTelemetry.Attributes.Map +Copyright : (c) Kazuki Okamoto (岡本和樹), 2023 +License : BSD-3 +Description : Key-value pair metadata used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's +Maintainer : Kazuki Okamoto (岡本和樹) +Stability : experimental +Portability : non-portable (GHC extensions) +-} +module OpenTelemetry.Attributes.Map ( + AttributeMap, + insertByKey, + insertAttributeByKey, + lookupByKey, + lookupAttributeByKey, +) where + +import qualified Data.HashMap.Strict as H +import Data.Text (Text) +import OpenTelemetry.Attributes.Attribute ( + Attribute, + FromAttribute (fromAttribute), + ToAttribute (toAttribute), + ) +import OpenTelemetry.Attributes.Key ( + Key (Key), + ) +import Prelude hiding (lookup, map) + + +type AttributeMap = H.HashMap Text Attribute + + +insertByKey :: ToAttribute a => Key a -> a -> AttributeMap -> AttributeMap +insertByKey (Key !k) !v = H.insert k (toAttribute v) + + +insertAttributeByKey :: Key a -> Attribute -> AttributeMap -> AttributeMap +insertAttributeByKey (Key !k) !v = H.insert k (toAttribute v) + + +lookupByKey :: FromAttribute a => Key a -> AttributeMap -> Maybe a +lookupByKey (Key k) attributes = H.lookup k attributes >>= fromAttribute + + +lookupAttributeByKey :: Key a -> AttributeMap -> Maybe Attribute +lookupAttributeByKey (Key k) = H.lookup k diff --git a/api/src/OpenTelemetry/Internal/Trace/Types.hs b/api/src/OpenTelemetry/Internal/Trace/Types.hs index 3fb61086..432cfef0 100644 --- a/api/src/OpenTelemetry/Internal/Trace/Types.hs +++ b/api/src/OpenTelemetry/Internal/Trace/Types.hs @@ -14,6 +14,7 @@ import Control.Monad.IO.Class import Data.Bits import Data.Default.Class (Default (def)) import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as H import Data.Hashable (Hashable) import Data.IORef (IORef, readIORef) import Data.String (IsString (..)) @@ -22,8 +23,7 @@ import Data.Vector (Vector) import Data.Word (Word8) import GHC.Generics import Network.HTTP.Types (RequestHeaders, ResponseHeaders) -import OpenTelemetry.Attribute.AttributeCollection -import OpenTelemetry.Attribute.Attributes (Attributes) +import OpenTelemetry.Attributes import OpenTelemetry.Common import OpenTelemetry.Context.Types import OpenTelemetry.Logging.Core (Log) @@ -182,7 +182,7 @@ This is not the case in scatter/gather and batch scenarios. data NewLink = NewLink { linkContext :: !SpanContext -- ^ @SpanContext@ of the @Span@ to link to. - , linkAttributes :: Attributes + , linkAttributes :: H.HashMap Text Attribute -- ^ Zero or more Attributes further describing the link. } deriving (Show) @@ -212,7 +212,7 @@ This is not the case in scatter/gather and batch scenarios. data Link = Link { frozenLinkContext :: !SpanContext -- ^ @SpanContext@ of the @Span@ to link to. - , frozenLinkAttributes :: AttributeCollection + , frozenLinkAttributes :: Attributes -- ^ Zero or more Attributes further describing the link. } deriving (Show) @@ -223,7 +223,7 @@ data SpanArguments = SpanArguments { kind :: SpanKind -- ^ The kind of the span. See 'SpanKind's documentation for the semantics -- of the various values that may be specified. - , attributes :: Attributes + , attributes :: H.HashMap Text Attribute -- ^ An initial set of attributes that may be set on initial 'Span' creation. -- These attributes are provided to 'Processor's, so they may be useful in some -- scenarios where calling `addAttribute` or `addAttributes` is too late. @@ -348,7 +348,7 @@ data ImmutableSpan = ImmutableSpan -- ^ A timestamp that corresponds to the start of the span , spanEnd :: Maybe Timestamp -- ^ A timestamp that corresponds to the end of the span, if the span has ended. - , spanAttributes :: AttributeCollection + , spanAttributes :: Attributes , spanLinks :: FrozenBoundedCollection Link -- ^ Zero or more links to related spans. Links can be useful for connecting causal relationships between things like web requests that enqueue asynchronous tasks to be processed. , spanEvents :: AppendOnlyBoundedCollection Event @@ -480,7 +480,7 @@ newtype NonRecordingSpan = NonRecordingSpan SpanContext data NewEvent = NewEvent { newEventName :: Text -- ^ The name of an event. Ideally this should be a relatively unique, but low cardinality value. - , newEventAttributes :: Attributes + , newEventAttributes :: H.HashMap Text Attribute -- ^ Additional context or metadata related to the event, (stack traces, callsites, etc.). , newEventTimestamp :: Maybe Timestamp -- ^ The time that the event occurred. @@ -496,7 +496,7 @@ data NewEvent = NewEvent data Event = Event { eventName :: Text -- ^ The name of an event. Ideally this should be a relatively unique, but low cardinality value. - , eventAttributes :: AttributeCollection + , eventAttributes :: Attributes -- ^ Additional context or metadata related to the event, (stack traces, callsites, etc.). , eventTimestamp :: Timestamp -- ^ The time that the event occurred. @@ -531,7 +531,7 @@ data SamplingResult data Sampler = Sampler { getDescription :: Text -- ^ Returns the sampler name or short description with the configuration. This may be displayed on debug pages or in the logs. - , shouldSample :: Context -> TraceId -> Text -> SpanArguments -> IO (SamplingResult, Attributes, TraceState) + , shouldSample :: Context -> TraceId -> Text -> SpanArguments -> IO (SamplingResult, H.HashMap Text Attribute, TraceState) } diff --git a/api/src/OpenTelemetry/Logging/Core.hs b/api/src/OpenTelemetry/Logging/Core.hs index d591e826..a1682eef 100644 --- a/api/src/OpenTelemetry/Logging/Core.hs +++ b/api/src/OpenTelemetry/Logging/Core.hs @@ -6,7 +6,7 @@ module OpenTelemetry.Logging.Core where import Data.Int (Int32, Int64) import Data.Text (Text) -import OpenTelemetry.Attribute (Attribute) +import OpenTelemetry.Attributes (Attribute) import OpenTelemetry.Common import OpenTelemetry.Resource (MaterializedResources) import OpenTelemetry.Trace.Id (SpanId, TraceId) diff --git a/api/src/OpenTelemetry/Resource.hs b/api/src/OpenTelemetry/Resource.hs index 5ef12bf1..d209ffe5 100644 --- a/api/src/OpenTelemetry/Resource.hs +++ b/api/src/OpenTelemetry/Resource.hs @@ -45,8 +45,9 @@ module OpenTelemetry.Resource ( import Data.Maybe (catMaybes) import Data.Proxy (Proxy (..)) +import Data.Text (Text) import GHC.TypeLits -import OpenTelemetry.Attribute +import OpenTelemetry.Attributes {- | A set of attributes created from one or more resources. @@ -64,7 +65,7 @@ import OpenTelemetry.Attribute The primary purpose of resources as a first-class concept in the SDK is decoupling of discovery of resource information from exporters. This allows for independent development and easy customization for users that need to integrate with closed source environments. -} -newtype Resource (schema :: Maybe Symbol) = Resource AttributeCollection +newtype Resource (schema :: Maybe Symbol) = Resource Attributes {- | Utility function to create a resource from a list @@ -72,22 +73,22 @@ newtype Resource (schema :: Maybe Symbol) = Resource AttributeCollection @since 0.0.1.0 -} -mkResource :: [Maybe (Key Attribute, Attribute)] -> Resource r +mkResource :: [Maybe (Text, Attribute)] -> Resource r mkResource = Resource . unsafeAttributesFromListIgnoringLimits . catMaybes {- | Utility function to convert a required resource attribute into the format needed for 'mkResource'. -} -(.=) :: (IsAttribute a) => Key a -> a -> Maybe (Key Attribute, Attribute) -(Key k) .= v = Just (Key k, toAttribute v) +(.=) :: (ToAttribute a) => Text -> a -> Maybe (Text, Attribute) +k .= v = Just (k, toAttribute v) {- | Utility function to convert an optional resource attribute into the format needed for 'mkResource'. -} -(.=?) :: (IsAttribute a) => Key a -> Maybe a -> Maybe (Key Attribute, Attribute) -k .=? mv = (\(Key k') v -> (Key k', toAttribute v)) k <$> mv +(.=?) :: (ToAttribute a) => Text -> Maybe a -> Maybe (Text, Attribute) +k .=? mv = (\k' v -> (k', toAttribute v)) k <$> mv instance Semigroup (Resource s) where @@ -173,7 +174,7 @@ instance (KnownSymbol s) => MaterializeResource ('Just s) where -- | A read-only resource attribute collection with an associated schema. data MaterializedResources = MaterializedResources { materializedResourcesSchema :: Maybe String - , materializedResourcesAttributes :: AttributeCollection + , materializedResourcesAttributes :: Attributes } deriving (Show) @@ -199,5 +200,5 @@ getMaterializedResourcesSchema = materializedResourcesSchema @since 0.0.1.0 -} -getMaterializedResourcesAttributes :: MaterializedResources -> AttributeCollection +getMaterializedResourcesAttributes :: MaterializedResources -> Attributes getMaterializedResourcesAttributes = materializedResourcesAttributes diff --git a/api/src/OpenTelemetry/Trace/Core.hs b/api/src/OpenTelemetry/Trace/Core.hs index 0eb06b35..3d01ad16 100644 --- a/api/src/OpenTelemetry/Trace/Core.hs +++ b/api/src/OpenTelemetry/Trace/Core.hs @@ -105,15 +105,17 @@ module OpenTelemetry.Trace.Core ( -- ** Enriching @Span@s with additional information updateName, OpenTelemetry.Trace.Core.addAttribute, + OpenTelemetry.Trace.Core.addAttributeByKey, OpenTelemetry.Trace.Core.addAttributes, spanGetAttributes, A.Attribute (..), - A.IsAttribute (..), + A.ToAttribute (..), + A.FromAttribute (..), A.PrimitiveAttribute (..), - A.IsPrimitiveAttribute (..), - A.Key (..), + A.ToPrimitiveAttribute (..), + A.FromPrimitiveAttribute (..), + A.Key, A.Attributes, - A.AttributeCollection, -- ** Recording error information recordException, @@ -151,6 +153,7 @@ import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Data.Coerce import Data.Default.Class (Default (def)) +import qualified Data.HashMap.Strict as H import Data.IORef import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) @@ -160,10 +163,7 @@ import qualified Data.Vector as V import Data.Word (Word64) import GHC.Stack import Network.HTTP.Types -import qualified OpenTelemetry.Attribute.Attribute as A -import qualified OpenTelemetry.Attribute.AttributeCollection as A -import qualified OpenTelemetry.Attribute.Attributes as A -import qualified OpenTelemetry.Attribute.Key as A +import qualified OpenTelemetry.Attributes as A import OpenTelemetry.Common import OpenTelemetry.Context import OpenTelemetry.Context.ThreadLocal @@ -208,7 +208,7 @@ createSpan :: -- | The created span. m Span createSpan t c n args@SpanArguments {attributes} = - createSpanWithoutCallStack t c n args {attributes = A.union attributes $ makeCodeAttributes callStack} + createSpanWithoutCallStack t c n args {attributes = H.union attributes $ makeCodeAttributes callStack} -- | The same thing as 'createSpan', except that it does not have a 'HasCallStack' constraint. @@ -277,7 +277,7 @@ createSpanWithoutCallStack t ctxt n args@SpanArguments {..} = liftIO $ do A.addAttributes (limitBy t spanAttributeCountLimit) A.emptyAttributes - (A.unions [additionalInfo, attrs, attributes]) + (H.unions [additionalInfo, attrs, attributes]) , spanLinks = let limitedLinks = fromMaybe 128 (linkCountLimit $ tracerProviderSpanLimits $ tracerProvider t) in frozenBoundedCollection limitedLinks $ fmap freezeLink links @@ -369,12 +369,12 @@ inSpan'' t cs n args f = (\(_, s) -> f s) -makeCodeAttributes :: CallStack -> A.Attributes +makeCodeAttributes :: CallStack -> H.HashMap Text A.Attribute makeCodeAttributes callStack' = case getCallStack callStack' of - [] -> A.empty + [] -> H.empty (_, loc) : rest -> - A.union + H.union [ ("code.namespace", A.toAttribute $ T.pack $ srcLocModule loc) , ("code.filepath", A.toAttribute $ T.pack $ srcLocFile loc) , ("code.lineno", A.toAttribute $ srcLocStartLine loc) @@ -419,11 +419,11 @@ Any additions to the 'otel.*' namespace MUST be approved as part of OpenTelemetr @since 0.0.1.0 -} addAttribute :: - (MonadIO m, A.IsAttribute a) => + (MonadIO m, A.ToAttribute a) => -- | Span to add the attribute to Span -> -- | Attribute name - A.Key a -> + Text -> -- | Attribute value a -> m () @@ -440,13 +440,25 @@ addAttribute (FrozenSpan _) _ _ = pure () addAttribute (Dropped _) _ _ = pure () +addAttributeByKey :: + (MonadIO m, A.ToAttribute a) => + -- | Span to add the attribute to + Span -> + -- | Attribute key + A.Key a -> + -- | Attribute value + a -> + m () +addAttributeByKey s (A.Key k) = addAttribute s k + + {- | A convenience function related to 'addAttribute' that adds multiple attributes to a span at the same time. This function may be slightly more performant than repeatedly calling 'addAttribute'. @since 0.0.1.0 -} -addAttributes :: MonadIO m => Span -> A.Attributes -> m () +addAttributes :: MonadIO m => Span -> H.HashMap Text A.Attribute -> m () addAttributes (Span s) attrs = liftIO $ modifyIORef' s $ \(!i) -> i { spanAttributes = @@ -558,7 +570,7 @@ endSpan (Dropped _) _ = pure () @since 0.0.1.0 -} -recordException :: (MonadIO m, Exception e) => Span -> A.Attributes -> Maybe Timestamp -> e -> m () +recordException :: (MonadIO m, Exception e) => Span -> H.HashMap Text A.Attribute -> Maybe Timestamp -> e -> m () recordException s attrs ts e = liftIO $ do cs <- whoCreated e let message = T.pack $ show e @@ -566,7 +578,7 @@ recordException s attrs ts e = liftIO $ do NewEvent { newEventName = "exception" , newEventAttributes = - A.union + H.union attrs [ ("exception.type", A.toAttribute $ T.pack $ show $ typeOf e) , ("exception.message", A.toAttribute message) @@ -615,7 +627,7 @@ wrapSpanContext = FrozenSpan using it to copy / otherwise use the data to further enrich instrumentation. -} -spanGetAttributes :: (MonadIO m) => Span -> m A.AttributeCollection +spanGetAttributes :: (MonadIO m) => Span -> m A.Attributes spanGetAttributes = \case Span ref -> do s <- liftIO $ readIORef ref diff --git a/api/src/OpenTelemetry/Trace/Sampler.hs b/api/src/OpenTelemetry/Trace/Sampler.hs index 449069c4..b8e6d595 100644 --- a/api/src/OpenTelemetry/Trace/Sampler.hs +++ b/api/src/OpenTelemetry/Trace/Sampler.hs @@ -38,7 +38,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Text import Data.Word (Word64) -import OpenTelemetry.Attribute (toAttribute) +import OpenTelemetry.Attributes (toAttribute) import OpenTelemetry.Context import OpenTelemetry.Internal.Trace.Types import OpenTelemetry.Trace.Id diff --git a/api/test/Spec.hs b/api/test/Spec.hs index c92cc0a0..7c3253a5 100644 --- a/api/test/Spec.hs +++ b/api/test/Spec.hs @@ -8,7 +8,7 @@ import qualified Data.Bifunctor import Data.IORef import Data.Maybe (isJust) import qualified Data.Vector as V -import OpenTelemetry.Attribute +import OpenTelemetry.Attributes (lookupAttribute) import qualified OpenTelemetry.BaggageSpec as Baggage import OpenTelemetry.Context import OpenTelemetry.Trace.Core diff --git a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs index afebfb5b..617a0048 100644 --- a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs +++ b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs @@ -58,6 +58,7 @@ import qualified Data.HashMap.Strict as H import Data.Maybe import Data.ProtoLens.Encoding import Data.ProtoLens.Message +import Data.Text (Text) import qualified Data.Text.Encoding as T import Data.Vector (Vector) import qualified Data.Vector as V @@ -67,10 +68,7 @@ import Network.HTTP.Client import Network.HTTP.Simple (httpBS) import Network.HTTP.Types.Header import Network.HTTP.Types.Status -import OpenTelemetry.Attribute -import qualified OpenTelemetry.Attribute.AttributeCollection as A -import qualified OpenTelemetry.Attribute.Attributes as A -import qualified OpenTelemetry.Attribute.Key as A +import OpenTelemetry.Attributes import qualified OpenTelemetry.Baggage as Baggage import OpenTelemetry.Exporter import OpenTelemetry.Resource @@ -300,20 +298,20 @@ otlpExporter conf = do else pure Success -attributesToProto :: AttributeCollection -> Vector KeyValue +attributesToProto :: Attributes -> Vector KeyValue attributesToProto = V.fromList . fmap attributeToKeyValue - . A.toList - . A.attributes + . H.toList + . getAttributes where primAttributeToAnyValue = \case TextAttribute t -> defMessage & stringValue .~ t BoolAttribute b -> defMessage & boolValue .~ b DoubleAttribute d -> defMessage & doubleValue .~ d IntAttribute i -> defMessage & intValue .~ i - attributeToKeyValue :: (Key Attribute, Attribute) -> KeyValue - attributeToKeyValue (A.Key k, v) = + attributeToKeyValue :: (Text, Attribute) -> KeyValue + attributeToKeyValue (k, v) = defMessage & key .~ k & value @@ -395,7 +393,7 @@ makeSpan completedSpan = do & startTimeUnixNano .~ startTime & endTimeUnixNano .~ maybe startTime timestampNanoseconds (OT.spanEnd completedSpan) & vec'attributes .~ attributesToProto (OT.spanAttributes completedSpan) - & droppedAttributesCount .~ fromIntegral (A.count $ OT.spanAttributes completedSpan) + & droppedAttributesCount .~ fromIntegral (getCount $ OT.spanAttributes completedSpan) & vec'events .~ fmap makeEvent (appendOnlyBoundedCollectionValues $ OT.spanEvents completedSpan) & droppedEventsCount .~ fromIntegral (appendOnlyBoundedCollectionDroppedElementCount (OT.spanEvents completedSpan)) & vec'links .~ fmap makeLink (frozenBoundedCollectionValues $ OT.spanLinks completedSpan) @@ -422,7 +420,7 @@ makeEvent e = & timeUnixNano .~ timestampNanoseconds (OT.eventTimestamp e) & Proto.Opentelemetry.Proto.Trace.V1.Trace_Fields.name .~ OT.eventName e & vec'attributes .~ attributesToProto (OT.eventAttributes e) - & droppedAttributesCount .~ fromIntegral (A.count $ OT.eventAttributes e) + & droppedAttributesCount .~ fromIntegral (getCount $ OT.eventAttributes e) makeLink :: OT.Link -> Span'Link @@ -431,4 +429,4 @@ makeLink l = & traceId .~ traceIdBytes (OT.traceId $ OT.frozenLinkContext l) & spanId .~ spanIdBytes (OT.spanId $ OT.frozenLinkContext l) & vec'attributes .~ attributesToProto (OT.frozenLinkAttributes l) - & droppedAttributesCount .~ fromIntegral (A.count $ OT.frozenLinkAttributes l) + & droppedAttributesCount .~ fromIntegral (getCount $ OT.frozenLinkAttributes l) diff --git a/instrumentation/cloudflare/hs-opentelemetry-instrumentation-cloudflare.cabal b/instrumentation/cloudflare/hs-opentelemetry-instrumentation-cloudflare.cabal index a6a045e4..7e37506a 100644 --- a/instrumentation/cloudflare/hs-opentelemetry-instrumentation-cloudflare.cabal +++ b/instrumentation/cloudflare/hs-opentelemetry-instrumentation-cloudflare.cabal @@ -37,6 +37,7 @@ library , hs-opentelemetry-instrumentation-wai , http-types , text + , unordered-containers , wai default-language: Haskell2010 @@ -56,5 +57,6 @@ test-suite cloudflare-test , hs-opentelemetry-instrumentation-wai , http-types , text + , unordered-containers , wai default-language: Haskell2010 diff --git a/instrumentation/cloudflare/package.yaml b/instrumentation/cloudflare/package.yaml index 3d49705a..8dc823f3 100644 --- a/instrumentation/cloudflare/package.yaml +++ b/instrumentation/cloudflare/package.yaml @@ -26,6 +26,7 @@ dependencies: - hs-opentelemetry-instrumentation-wai - case-insensitive - text +- unordered-containers library: source-dirs: src diff --git a/instrumentation/cloudflare/src/OpenTelemetry/Instrumentation/Cloudflare.hs b/instrumentation/cloudflare/src/OpenTelemetry/Instrumentation/Cloudflare.hs index 8c751c33..bdaee0f6 100644 --- a/instrumentation/cloudflare/src/OpenTelemetry/Instrumentation/Cloudflare.hs +++ b/instrumentation/cloudflare/src/OpenTelemetry/Instrumentation/Cloudflare.hs @@ -5,14 +5,13 @@ module OpenTelemetry.Instrumentation.Cloudflare where import Control.Monad (forM_) import qualified Data.CaseInsensitive as CI +import qualified Data.HashMap.Strict as H import qualified Data.List import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T import Network.Wai -import OpenTelemetry.Attribute (IsAttribute (..), PrimitiveAttribute (..)) -import qualified OpenTelemetry.Attribute as A -import qualified OpenTelemetry.Attribute.Attributes as A +import OpenTelemetry.Attributes (PrimitiveAttribute (..), ToAttribute (..)) import OpenTelemetry.Context import OpenTelemetry.Instrumentation.Wai (requestContext) import OpenTelemetry.Trace.Core (addAttributes) @@ -24,13 +23,13 @@ cloudflareInstrumentationMiddleware app req sendResp = do forM_ mCtxt $ \ctxt -> do forM_ (lookupSpan ctxt) $ \span_ -> do addAttributes span_ $ - A.unions $ + H.unions $ fmap ( \hn -> case Data.List.lookup hn $ requestHeaders req of Nothing -> [] Just val -> [ - ( A.Key $ "http.request.header." <> T.decodeUtf8 (CI.foldedCase hn) + ( "http.request.header." <> T.decodeUtf8 (CI.foldedCase hn) , toAttribute $ T.decodeUtf8 val ) ] diff --git a/instrumentation/hedis/hs-opentelemetry-instrumentation-hedis.cabal b/instrumentation/hedis/hs-opentelemetry-instrumentation-hedis.cabal index 2c9184d0..bb169e01 100644 --- a/instrumentation/hedis/hs-opentelemetry-instrumentation-hedis.cabal +++ b/instrumentation/hedis/hs-opentelemetry-instrumentation-hedis.cabal @@ -34,7 +34,8 @@ library mtl, safe-exceptions, text, - unliftio-core + unliftio-core, + unordered-containers ghc-options: -Wcompat -Wno-name-shadowing if impl(ghc >= 6.4) diff --git a/instrumentation/hedis/src/OpenTelemetry/Instrumentation/Hedis.hs b/instrumentation/hedis/src/OpenTelemetry/Instrumentation/Hedis.hs index 6680fc2d..d66c4cc0 100644 --- a/instrumentation/hedis/src/OpenTelemetry/Instrumentation/Hedis.hs +++ b/instrumentation/hedis/src/OpenTelemetry/Instrumentation/Hedis.hs @@ -363,6 +363,7 @@ import qualified Control.Exception.Safe as E import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Reader (MonadReader (), ReaderT (ReaderT, runReaderT)) import Data.ByteString (ByteString) +import qualified Data.HashMap.Strict as H import Data.IP (IP) import Data.String (IsString (fromString)) import Data.Text (Text) @@ -370,7 +371,7 @@ import qualified Database.Redis as Orig import GHC.Stack (HasCallStack) import OpenTelemetry.Instrumentation.Hedis.Internal.Action import OpenTelemetry.Instrumentation.Hedis.Internal.Wrapper (wrap0, wrap1, wrap2) -import qualified OpenTelemetry.Trace.Core as Otel (Attribute, Attributes, Key, SpanArguments (attributes, kind), SpanKind (Client), Tracer, TracerProvider, defaultSpanArguments, getGlobalTracerProvider, inSpan, makeTracer, tracerOptions) +import qualified OpenTelemetry.Trace.Core as Otel (Attribute, SpanArguments (attributes, kind), SpanKind (Client), Tracer, TracerProvider, defaultSpanArguments, getGlobalTracerProvider, inSpan, makeTracer, tracerOptions) import qualified OpenTelemetry.Trace.Monad as Otel (MonadTracer, TracerT (TracerT)) import Text.Read (readMaybe) @@ -553,11 +554,11 @@ inSpan tracer name info f = do Otel.inSpan tracer name args f -makeAttributes :: Orig.ConnectInfo -> Otel.Attributes +makeAttributes :: Orig.ConnectInfo -> H.HashMap Text Otel.Attribute makeAttributes info@Orig.ConnInfo {Orig.connectHost, Orig.connectPort} = let transportAttr :: Otel.Attribute - portAttr :: (Otel.Key Otel.Attribute, Otel.Attribute) + portAttr :: (Text, Otel.Attribute) (transportAttr, portAttr) = case connectPort of Orig.PortNumber n -> ("ip_tcp", ("net.peer.port", fromString $ show n)) diff --git a/instrumentation/herp-logger-datadog/src/OpenTelemetry/Instrumentation/Herp/Logger/Datadog.hs b/instrumentation/herp-logger-datadog/src/OpenTelemetry/Instrumentation/Herp/Logger/Datadog.hs index fc087486..1e2c5f55 100644 --- a/instrumentation/herp-logger-datadog/src/OpenTelemetry/Instrumentation/Herp/Logger/Datadog.hs +++ b/instrumentation/herp-logger-datadog/src/OpenTelemetry/Instrumentation/Herp/Logger/Datadog.hs @@ -68,8 +68,8 @@ import Herp.Logger ((.=)) import qualified Herp.Logger as Orig import qualified Herp.Logger.LogLevel as Orig import qualified Herp.Logger.Payload as Orig -import qualified OpenTelemetry.Attribute.AttributeCollection as OtelAttr -import qualified OpenTelemetry.Attribute.Attributes as OtelAttr +import qualified OpenTelemetry.Attributes as Otel +import qualified OpenTelemetry.Attributes.Map as Otel import qualified OpenTelemetry.Context as Otel import qualified OpenTelemetry.Context.ThreadLocal as Otel import qualified OpenTelemetry.Resource as Otel @@ -208,14 +208,14 @@ datadogPayload tracerProvider maybeSpan = do let attributes = Otel.getMaterializedResourcesAttributes $ Otel.getTracerProviderResources tracerProvider maybeEnv :: Maybe Text - maybeEnv = OtelAttr.lookup Datadog.envKey $ OtelAttr.attributes attributes + maybeEnv = Otel.lookupByKey Datadog.envKey $ Otel.getAttributes attributes maybeService = - ( OtelAttr.lookup Datadog.serviceKey (OtelAttr.attributes attributes) + ( Otel.lookupByKey Datadog.serviceKey (Otel.getAttributes attributes) <|> -- "service.name" is the same key in the OpenTelemetry.Resource.Service module - OtelAttr.lookup "service.name" (OtelAttr.attributes attributes) + Otel.lookupByKey Otel.peer_service (Otel.getAttributes attributes) ) - maybeVersion = OtelAttr.lookup Datadog.versionKey (OtelAttr.attributes attributes) + maybeVersion = Otel.lookupByKey Datadog.versionKey (Otel.getAttributes attributes) pure $ (\payloadObject -> mempty {Orig.payloadObject}) $ Aeson.fromList $ diff --git a/instrumentation/hspec/src/OpenTelemetry/Instrumentation/Hspec.hs b/instrumentation/hspec/src/OpenTelemetry/Instrumentation/Hspec.hs index e0bb4e69..53a31496 100644 --- a/instrumentation/hspec/src/OpenTelemetry/Instrumentation/Hspec.hs +++ b/instrumentation/hspec/src/OpenTelemetry/Instrumentation/Hspec.hs @@ -13,7 +13,7 @@ import Control.Monad.Reader import qualified Data.List as List import Data.Text (Text) import qualified Data.Text as T -import OpenTelemetry.Attribute (Attributes) +import OpenTelemetry.Attributes (Attributes) import OpenTelemetry.Context import OpenTelemetry.Context.ThreadLocal (adjustContext, attachContext, getContext) import OpenTelemetry.Trace.Core diff --git a/instrumentation/http-client/src/OpenTelemetry/Instrumentation/HttpClient/Raw.hs b/instrumentation/http-client/src/OpenTelemetry/Instrumentation/HttpClient/Raw.hs index 9313933a..dfc9d86c 100644 --- a/instrumentation/http-client/src/OpenTelemetry/Instrumentation/HttpClient/Raw.hs +++ b/instrumentation/http-client/src/OpenTelemetry/Instrumentation/HttpClient/Raw.hs @@ -8,14 +8,13 @@ import Control.Monad (forM_, when) import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as B import Data.CaseInsensitive (foldedCase) +import qualified Data.HashMap.Strict as H import Data.Maybe (mapMaybe) import qualified Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T import Network.HTTP.Client import Network.HTTP.Types -import qualified OpenTelemetry.Attribute as A -import qualified OpenTelemetry.Attribute.Attributes as A import OpenTelemetry.Context (Context, lookupSpan) import OpenTelemetry.Context.ThreadLocal import OpenTelemetry.Propagator @@ -94,9 +93,9 @@ instrumentRequest tracer conf ctxt req = do ) ] addAttributes s - $ A.fromList + $ H.fromList $ mapMaybe - (\h -> (\v -> (A.Key $ "http.request.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (requestHeaders req)) + (\h -> (\v -> ("http.request.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (requestHeaders req)) $ requestHeadersToRecord conf hdrs <- inject (getTracerProviderPropagators $ getTracerTracerProvider tracer) ctxt $ requestHeaders req @@ -133,7 +132,7 @@ instrumentResponse tracer conf ctxt resp = do -- , ("net.peer.port") ] addAttributes s - $ A.fromList + $ H.fromList $ mapMaybe - (\h -> (\v -> (A.Key $ "http.response.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (responseHeaders resp)) + (\h -> (\v -> ("http.response.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (responseHeaders resp)) $ responseHeadersToRecord conf diff --git a/instrumentation/persistent-mysql/hs-opentelemetry-instrumentation-persistent-mysql.cabal b/instrumentation/persistent-mysql/hs-opentelemetry-instrumentation-persistent-mysql.cabal index 55b85482..033688bf 100644 --- a/instrumentation/persistent-mysql/hs-opentelemetry-instrumentation-persistent-mysql.cabal +++ b/instrumentation/persistent-mysql/hs-opentelemetry-instrumentation-persistent-mysql.cabal @@ -24,7 +24,9 @@ library persistent, persistent-mysql, resource-pool, - unliftio-core + text, + unliftio-core, + unordered-containers ghc-options: -Wcompat -Wno-name-shadowing if impl(ghc >= 6.4) diff --git a/instrumentation/persistent-mysql/src/OpenTelemetry/Instrumentation/Persistent/MySQL.hs b/instrumentation/persistent-mysql/src/OpenTelemetry/Instrumentation/Persistent/MySQL.hs index 7a7223ba..2deb660e 100644 --- a/instrumentation/persistent-mysql/src/OpenTelemetry/Instrumentation/Persistent/MySQL.hs +++ b/instrumentation/persistent-mysql/src/OpenTelemetry/Instrumentation/Persistent/MySQL.hs @@ -32,16 +32,17 @@ import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Logger (MonadLoggerIO) import Data.Foldable (Foldable (fold)) import Data.Functor ((<&>)) +import qualified Data.HashMap.Strict as H import Data.IP (IP) import Data.Maybe (fromMaybe) import Data.Monoid (Last (Last, getLast)) import Data.Pool (Pool) import Data.String (IsString (fromString)) +import Data.Text (Text) import Database.MySQL.Base (ConnectInfo (..)) import qualified Database.MySQL.Base as MySQL import qualified Database.Persist.MySQL as Orig import Database.Persist.Sql -import qualified OpenTelemetry.Attribute.Attributes as OtelAttr import qualified OpenTelemetry.Instrumentation.Persistent as Otel import qualified OpenTelemetry.Trace.Core as Otel import Text.Read (readMaybe) @@ -55,7 +56,7 @@ createMySQLPool :: (MonadUnliftIO m, MonadLoggerIO m) => Otel.TracerProvider -> -- | Additional attributes. - Otel.Attributes -> + H.HashMap Text Otel.Attribute -> -- | Connection information. MySQL.ConnectInfo -> -- | Number of connections to be kept open in the pool. @@ -73,7 +74,7 @@ withMySQLPool :: (MonadLoggerIO m, MonadUnliftIO m) => Otel.TracerProvider -> -- | Additional attributes. - Otel.Attributes -> + H.HashMap Text Otel.Attribute -> -- | Connection information. MySQL.ConnectInfo -> -- | Number of connections to be kept open in the pool. @@ -92,7 +93,7 @@ About attributes, see https://opentelemetry.io/docs/reference/specification/trac openMySQLConn :: Otel.TracerProvider -> -- | Additional attributes. - Otel.Attributes -> + H.HashMap Text Otel.Attribute -> -- | Connection information. MySQL.ConnectInfo -> LogFunc -> @@ -115,7 +116,7 @@ openMySQLConn tp attrs ci@MySQL.ConnectInfo {connectUser, connectPort, connectOp _ -> Last Nothing -- "net.sock.family" is unnecessary because it must be "inet" when "net.sock.peer.addr" or "net.sock.host.addr" is set. attrs' = - OtelAttr.union + H.union [ ("db.connection_string", fromString $ showsPrecConnectInfoMasked 0 ci "") , ("db.user", fromString connectUser) , ("net.peer.port", portAttr) @@ -136,7 +137,7 @@ withMySQLConn :: (MonadUnliftIO m, MonadLoggerIO m) => Otel.TracerProvider -> -- | Additional attributes. - Otel.Attributes -> + H.HashMap Text Otel.Attribute -> -- | Connection information. MySQL.ConnectInfo -> -- | Action to be executed that uses the connection. diff --git a/instrumentation/persistent/src/OpenTelemetry/Instrumentation/Persistent.hs b/instrumentation/persistent/src/OpenTelemetry/Instrumentation/Persistent.hs index d78021ce..1f49a65e 100644 --- a/instrumentation/persistent/src/OpenTelemetry/Instrumentation/Persistent.hs +++ b/instrumentation/persistent/src/OpenTelemetry/Instrumentation/Persistent.hs @@ -20,8 +20,7 @@ import Database.Persist.Sql import Database.Persist.SqlBackend (MkSqlBackendArgs (connRDBMS), emptySqlBackendHooks, getConnVault, getRDBMS, modifyConnVault, setConnHooks) import Database.Persist.SqlBackend.Internal import GHC.Stack (withFrozenCallStack) -import OpenTelemetry.Attribute (Attributes) -import qualified OpenTelemetry.Attribute.Attributes as A +import OpenTelemetry.Attributes (Attributes) import OpenTelemetry.Context import OpenTelemetry.Context.ThreadLocal (adjustContext, getContext) import OpenTelemetry.Resource @@ -56,7 +55,7 @@ lookupOriginalConnection :: SqlBackend -> Maybe SqlBackend lookupOriginalConnection = Vault.lookup originalConnectionKey . getConnVault -connectionLevelAttributesKey :: Vault.Key (Attributes) +connectionLevelAttributesKey :: Vault.Key (H.HashMap Text Attribute) connectionLevelAttributesKey = unsafePerformIO Vault.newKey {-# NOINLINE connectionLevelAttributesKey #-} @@ -67,7 +66,7 @@ connectionLevelAttributesKey = unsafePerformIO Vault.newKey wrapSqlBackend :: (MonadIO m) => -- | Attributes that are specific to providers like MySQL, PostgreSQL, etc. - Attributes -> + H.HashMap Text Attribute -> SqlBackend -> m SqlBackend wrapSqlBackend attrs conn_ = do @@ -81,7 +80,7 @@ so that queries are tracked appropriately in the tracing hierarchy. wrapSqlBackend' :: TracerProvider -> -- | Attributes that are specific to providers like MySQL, PostgreSQL, etc. - Attributes -> + H.HashMap Text Attribute -> SqlBackend -> SqlBackend wrapSqlBackend' tp attrs conn_ = @@ -101,7 +100,7 @@ wrapSqlBackend' tp attrs conn_ = t ctxt sql - (defaultSpanArguments {kind = Client, attributes = A.insert "db.statement" (toAttribute sql) attrs}) + (defaultSpanArguments {kind = Client, attributes = H.insert "db.statement" (toAttribute sql) attrs}) adjustContext (insertSpan s) pure (lookupSpan ctxt, s) spanCleanup (parent, s) = do @@ -122,7 +121,7 @@ wrapSqlBackend' tp attrs conn_ = ) (stmtQueryAcquireF f) , stmtExecute = withFrozenCallStack $ \ps -> do - inSpan' t sql (defaultSpanArguments {kind = Client, attributes = A.insert "db.statement" (toAttribute sql) attrs}) $ \s -> do + inSpan' t sql (defaultSpanArguments {kind = Client, attributes = H.insert "db.statement" (toAttribute sql) attrs}) $ \s -> do annotateBasics s conn stmtExecute stmt ps , stmtReset = stmtReset stmt @@ -141,16 +140,16 @@ wrapSqlBackend' tp attrs conn_ = Just ReadCommitted -> " isolation level read committed" Just RepeatableRead -> " isolation level repeatable read" Just Serializable -> " isolation level serializable" - let attrs' = A.insert "db.statement" (toAttribute statement) attrs + let attrs' = H.insert "db.statement" (toAttribute statement) attrs inSpan' t statement (defaultSpanArguments {kind = Client, attributes = attrs'}) $ \s -> do annotateBasics s conn connBegin conn f mIso , connCommit = withFrozenCallStack $ \f -> do - inSpan' t "commit" (defaultSpanArguments {kind = Client, attributes = A.insert "db.statement" (toAttribute ("commit" :: Text)) attrs}) $ \s -> do + inSpan' t "commit" (defaultSpanArguments {kind = Client, attributes = H.insert "db.statement" (toAttribute ("commit" :: Text)) attrs}) $ \s -> do annotateBasics s conn connCommit conn f , connRollback = withFrozenCallStack $ \f -> do - inSpan' t "rollback" (defaultSpanArguments {kind = Client, attributes = A.insert "db.statement" (toAttribute ("rollback" :: Text)) attrs}) $ \s -> do + inSpan' t "rollback" (defaultSpanArguments {kind = Client, attributes = H.insert "db.statement" (toAttribute ("rollback" :: Text)) attrs}) $ \s -> do annotateBasics s conn connRollback conn f , connClose = withFrozenCallStack $ do diff --git a/instrumentation/postgresql-simple/src/OpenTelemetry/Instrumentation/PostgresqlSimple.hs b/instrumentation/postgresql-simple/src/OpenTelemetry/Instrumentation/PostgresqlSimple.hs index 13b533a7..143db867 100644 --- a/instrumentation/postgresql-simple/src/OpenTelemetry/Instrumentation/PostgresqlSimple.hs +++ b/instrumentation/postgresql-simple/src/OpenTelemetry/Instrumentation/PostgresqlSimple.hs @@ -74,7 +74,6 @@ import Database.PostgreSQL.Simple.Internal ( Connection (Connection, connectionHandle), ) import GHC.Stack -import qualified OpenTelemetry.Attribute.Attributes as A import OpenTelemetry.Resource ((.=), (.=?)) import OpenTelemetry.Trace.Core import OpenTelemetry.Trace.Monad @@ -83,7 +82,7 @@ import UnliftIO -- | Get attributes that can be attached to a span denoting some database action -staticConnectionAttributes :: MonadIO m => Connection -> m Attributes +staticConnectionAttributes :: MonadIO m => Connection -> m (H.HashMap T.Text Attribute) staticConnectionAttributes Connection {connectionHandle} = liftIO $ do (mDb, mUser, mHost, mPort) <- withMVar connectionHandle $ \pqConn -> do (,,,) @@ -92,7 +91,7 @@ staticConnectionAttributes Connection {connectionHandle} = liftIO $ do <*> LibPQ.host pqConn <*> LibPQ.port pqConn pure $ - A.fromList $ + H.fromList $ catMaybes [ "db.system" .= toAttribute ("postgresql" :: T.Text) , "db.user" .=? (TE.decodeUtf8 <$> mUser) diff --git a/instrumentation/wai/src/OpenTelemetry/Instrumentation/Wai.hs b/instrumentation/wai/src/OpenTelemetry/Instrumentation/Wai.hs index e55e5a39..1f2f390a 100644 --- a/instrumentation/wai/src/OpenTelemetry/Instrumentation/Wai.hs +++ b/instrumentation/wai/src/OpenTelemetry/Instrumentation/Wai.hs @@ -18,7 +18,7 @@ import GHC.Stack (withFrozenCallStack) import Network.HTTP.Types import Network.Socket import Network.Wai -import OpenTelemetry.Attribute (lookupAttribute) +import OpenTelemetry.Attributes (lookupAttribute) import qualified OpenTelemetry.Context as Context import OpenTelemetry.Context.ThreadLocal import OpenTelemetry.Propagator diff --git a/instrumentation/yesod/hs-opentelemetry-instrumentation-yesod.cabal b/instrumentation/yesod/hs-opentelemetry-instrumentation-yesod.cabal index 52a3ef4d..28df383e 100644 --- a/instrumentation/yesod/hs-opentelemetry-instrumentation-yesod.cabal +++ b/instrumentation/yesod/hs-opentelemetry-instrumentation-yesod.cabal @@ -43,6 +43,7 @@ library , template-haskell , text , unliftio + , unordered-containers , vault , wai , yesod-core @@ -67,6 +68,7 @@ test-suite hs-opentelemetry-instrumentation-yesod-test , template-haskell , text , unliftio + , unordered-containers , vault , wai , yesod-core diff --git a/instrumentation/yesod/package.yaml b/instrumentation/yesod/package.yaml index 2871d1b0..5f5caad9 100644 --- a/instrumentation/yesod/package.yaml +++ b/instrumentation/yesod/package.yaml @@ -31,6 +31,7 @@ dependencies: - template-haskell - vault - wai +- unordered-containers library: ghc-options: -Wall diff --git a/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs b/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs index 7069dac5..271197d5 100644 --- a/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs +++ b/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs @@ -29,7 +29,15 @@ module OpenTelemetry.Instrumentation.Yesod ( handlerEnvL, ) where + +#if MIN_VERSION_template_haskell(2, 17, 0) +import Language.Haskell.TH (Quote (newName)) +#else +import Language.Haskell.TH (newName) +#endif + import Control.Monad.IO.Class (MonadIO) +import qualified Data.HashMap.Strict as H import Data.List (intercalate) import Data.Map (Map) import qualified Data.Map as M @@ -61,14 +69,13 @@ import Language.Haskell.TH ( ) import Lens.Micro (Lens', lens) import Network.Wai (Request (vault), requestHeaders) -import qualified OpenTelemetry.Attribute.Attributes as A import qualified OpenTelemetry.Context as Context import OpenTelemetry.Context.ThreadLocal (getContext) import OpenTelemetry.Trace.Core ( - IsAttribute (toAttribute), Span, SpanArguments (attributes, kind), SpanKind (Internal, Server), + ToAttribute (toAttribute), Tracer, TracerProvider, addAttributes, @@ -113,13 +120,6 @@ import Yesod.Routes.TH.Types ( ) -#if MIN_VERSION_template_haskell(2, 17, 0) -import Language.Haskell.TH (Quote (newName)) -#else -import Language.Haskell.TH (newName) -#endif - - handlerEnvL :: Lens' (HandlerData child site) (RunHandlerEnv child site) handlerEnvL = lens handlerEnv (\h e -> h {handlerEnv = e}) {-# INLINE handlerEnvL #-} @@ -330,7 +330,7 @@ openTelemetryYesodMiddleware rr (HandlerFor doResponse) = mspan <- Context.lookupSpan <$> getContext mr <- getCurrentRoute let sharedAttributes = - A.fromList $ + H.fromList $ catMaybes [ do r <- mr diff --git a/sdk/hs-opentelemetry-sdk.cabal b/sdk/hs-opentelemetry-sdk.cabal index 4d49dd18..d6cf7282 100644 --- a/sdk/hs-opentelemetry-sdk.cabal +++ b/sdk/hs-opentelemetry-sdk.cabal @@ -41,11 +41,10 @@ library other-modules: Paths_hs_opentelemetry_sdk reexported-modules: - OpenTelemetry.Attribute - , OpenTelemetry.Attribute.Attribute - , OpenTelemetry.Attribute.Attributes - , OpenTelemetry.Attribute.AttributeCollection - , OpenTelemetry.Attribute.Key + OpenTelemetry.Attributes + , OpenTelemetry.Attributes.Attribute + , OpenTelemetry.Attributes.Key + , OpenTelemetry.Attributes.Map , OpenTelemetry.Baggage , OpenTelemetry.Context , OpenTelemetry.Context.ThreadLocal diff --git a/sdk/package.yaml b/sdk/package.yaml index 8db5b14c..16804d94 100644 --- a/sdk/package.yaml +++ b/sdk/package.yaml @@ -49,11 +49,10 @@ library: ghc-options: -Wall source-dirs: src reexported-modules: - - OpenTelemetry.Attribute - - OpenTelemetry.Attribute.Attribute - - OpenTelemetry.Attribute.Attributes - - OpenTelemetry.Attribute.AttributeCollection - - OpenTelemetry.Attribute.Key + - OpenTelemetry.Attributes + - OpenTelemetry.Attributes.Attribute + - OpenTelemetry.Attributes.Key + - OpenTelemetry.Attributes.Map - OpenTelemetry.Baggage - OpenTelemetry.Context - OpenTelemetry.Context.ThreadLocal diff --git a/sdk/src/OpenTelemetry/Trace.hs b/sdk/src/OpenTelemetry/Trace.hs index ead396e6..73c91f65 100644 --- a/sdk/src/OpenTelemetry/Trace.hs +++ b/sdk/src/OpenTelemetry/Trace.hs @@ -150,8 +150,10 @@ module OpenTelemetry.Trace ( createSpanWithoutCallStack, endSpan, spanGetAttributes, - IsAttribute (..), - IsPrimitiveAttribute (..), + ToAttribute (..), + FromAttribute (..), + ToPrimitiveAttribute (..), + FromPrimitiveAttribute (..), Attribute (..), PrimitiveAttribute (..), Link, @@ -168,7 +170,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import Network.HTTP.Types.Header -import OpenTelemetry.Attribute (AttributeLimits (..), defaultAttributeLimits) +import OpenTelemetry.Attributes (AttributeLimits (..), defaultAttributeLimits) import OpenTelemetry.Baggage (decodeBaggageHeader) import qualified OpenTelemetry.Baggage as Baggage import OpenTelemetry.Context (Context) @@ -483,7 +485,7 @@ detectExporters = do -- -- detectMetricsExporterSelection :: _ -- -- TODO other metrics stuff -detectResourceAttributes :: IO [(Key Attribute, Attribute)] +detectResourceAttributes :: IO [(T.Text, Attribute)] detectResourceAttributes = do mEnv <- lookupEnv "OTEL_RESOURCE_ATTRIBUTES" case mEnv of @@ -495,7 +497,7 @@ detectResourceAttributes = do pure [] Right ok -> pure $ - map (\(k, v) -> (Key $ decodeUtf8 $ Baggage.tokenValue k, toAttribute $ Baggage.value v)) $ + map (\(k, v) -> (decodeUtf8 $ Baggage.tokenValue k, toAttribute $ Baggage.value v)) $ H.toList $ Baggage.values ok diff --git a/utils/exceptions/src/OpenTelemetry/Utils/Exceptions.hs b/utils/exceptions/src/OpenTelemetry/Utils/Exceptions.hs index 20d5031e..44e79e16 100644 --- a/utils/exceptions/src/OpenTelemetry/Utils/Exceptions.hs +++ b/utils/exceptions/src/OpenTelemetry/Utils/Exceptions.hs @@ -17,7 +17,7 @@ import OpenTelemetry.Context (insertSpan, lookupSpan, removeSpan) import OpenTelemetry.Context.ThreadLocal (adjustContext) import qualified OpenTelemetry.Context.ThreadLocal as TraceCore.SpanContext import qualified OpenTelemetry.Trace as Trace -import OpenTelemetry.Trace.Core (IsAttribute (..), endSpan, recordException, setStatus, whenSpanIsRecording) +import OpenTelemetry.Trace.Core (ToAttribute (..), endSpan, recordException, setStatus, whenSpanIsRecording) import qualified OpenTelemetry.Trace.Core as TraceCore diff --git a/vendors/datadog/src/OpenTelemetry/Vendor/Datadog.hs b/vendors/datadog/src/OpenTelemetry/Vendor/Datadog.hs index ca3c51cb..53a785dc 100644 --- a/vendors/datadog/src/OpenTelemetry/Vendor/Datadog.hs +++ b/vendors/datadog/src/OpenTelemetry/Vendor/Datadog.hs @@ -31,7 +31,7 @@ module OpenTelemetry.Vendor.Datadog ( -- - -- | These are keys to lookup or insert 'OpenTelemetry.Attributes.Attribute's to 'OpenTelemetry.Attributes.Attributes' with. + -- | These are keys to lookup or insert 'OpenTelemetry.Attributes.Attribute's to 'OpenTelemetry.Attributes' with. envKey, serviceKey, versionKey, @@ -45,7 +45,7 @@ import Data.Primitive (ByteArray (ByteArray)) import Data.String (fromString) import Data.Text (Text) import Data.Word (Word64) -import qualified OpenTelemetry.Attribute as Attribute +import qualified OpenTelemetry.Attributes as Attribute import qualified OpenTelemetry.Internal.Trace.Id as Trace import OpenTelemetry.Resource (Resource, mkResource) import OpenTelemetry.Vendor.Datadog.Internal (indexByteArrayNbo) @@ -83,4 +83,4 @@ detectResource = do env <- (envKey,) <$> lookupEnv "DD_ENV" service <- (serviceKey,) <$> lookupEnv "DD_SERVICE" version <- (versionKey,) <$> lookupEnv "DD_VERSION" - pure $ mkResource $ (\(Attribute.Key k, mv) -> (Attribute.Key k,) . fromString <$> mv) <$> [env, service, version] + pure $ mkResource $ (\(Attribute.Key k, mv) -> (k,) . fromString <$> mv) <$> [env, service, version]