From bdb7231de77babdb10390a9eee6528bc7636913f Mon Sep 17 00:00:00 2001 From: Kazuki Okamoto Date: Thu, 21 Dec 2023 01:27:20 +0900 Subject: [PATCH 1/2] rearrange attributes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Change: Attributes → AttributeCollection HashMap Text Attribute → Attributes New: Key for Attributes --- api/hs-opentelemetry-api.cabal | 6 +- api/src/OpenTelemetry/Attribute.hs | 27 + api/src/OpenTelemetry/Attribute/Attribute.hs | 174 ++++ .../Attribute/AttributeCollection.hs | 169 ++++ api/src/OpenTelemetry/Attribute/Attributes.hs | 115 +++ api/src/OpenTelemetry/Attribute/Key.hs | 904 ++++++++++++++++++ api/src/OpenTelemetry/Attributes.hs | 274 ------ api/src/OpenTelemetry/Internal/Trace/Types.hs | 18 +- api/src/OpenTelemetry/Logging/Core.hs | 2 +- api/src/OpenTelemetry/Resource.hs | 19 +- api/src/OpenTelemetry/Trace/Core.hs | 35 +- api/src/OpenTelemetry/Trace/Sampler.hs | 2 +- api/test/Spec.hs | 6 +- .../otlp/src/OpenTelemetry/Exporter/OTLP.hs | 23 +- ...telemetry-instrumentation-cloudflare.cabal | 2 - instrumentation/cloudflare/package.yaml | 1 - .../Instrumentation/Cloudflare.hs | 9 +- ...-opentelemetry-instrumentation-hedis.cabal | 3 +- .../OpenTelemetry/Instrumentation/Hedis.hs | 7 +- .../Instrumentation/Herp/Logger/Datadog.hs | 24 +- .../OpenTelemetry/Instrumentation/Hspec.hs | 2 +- .../Instrumentation/HttpClient/Raw.hs | 11 +- ...try-instrumentation-persistent-mysql.cabal | 4 +- .../Instrumentation/Persistent/MySQL.hs | 13 +- .../Instrumentation/Persistent.hs | 19 +- .../Instrumentation/PostgresqlSimple.hs | 5 +- .../src/OpenTelemetry/Instrumentation/Wai.hs | 2 +- ...-opentelemetry-instrumentation-yesod.cabal | 2 - instrumentation/yesod/package.yaml | 1 - .../OpenTelemetry/Instrumentation/Yesod.hs | 24 +- sdk/hs-opentelemetry-sdk.cabal | 6 +- sdk/package.yaml | 6 +- sdk/src/OpenTelemetry/Trace.hs | 10 +- .../src/OpenTelemetry/Utils/Exceptions.hs | 2 +- .../hs-opentelemetry-vendor-datadog.cabal | 1 - .../src/OpenTelemetry/Vendor/Datadog.hs | 9 +- 36 files changed, 1528 insertions(+), 409 deletions(-) create mode 100644 api/src/OpenTelemetry/Attribute.hs create mode 100644 api/src/OpenTelemetry/Attribute/Attribute.hs create mode 100644 api/src/OpenTelemetry/Attribute/AttributeCollection.hs create mode 100644 api/src/OpenTelemetry/Attribute/Attributes.hs create mode 100644 api/src/OpenTelemetry/Attribute/Key.hs delete mode 100644 api/src/OpenTelemetry/Attributes.hs diff --git a/api/hs-opentelemetry-api.cabal b/api/hs-opentelemetry-api.cabal index ce3f966b..52630bc7 100644 --- a/api/hs-opentelemetry-api.cabal +++ b/api/hs-opentelemetry-api.cabal @@ -27,7 +27,11 @@ source-repository head library exposed-modules: - OpenTelemetry.Attributes + OpenTelemetry.Attribute + OpenTelemetry.Attribute.Attribute + OpenTelemetry.Attribute.AttributeCollection + OpenTelemetry.Attribute.Attributes + OpenTelemetry.Attribute.Key OpenTelemetry.Baggage OpenTelemetry.Common OpenTelemetry.Context diff --git a/api/src/OpenTelemetry/Attribute.hs b/api/src/OpenTelemetry/Attribute.hs new file mode 100644 index 00000000..351c7711 --- /dev/null +++ b/api/src/OpenTelemetry/Attribute.hs @@ -0,0 +1,27 @@ +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/Attribute.hs b/api/src/OpenTelemetry/Attribute/Attribute.hs new file mode 100644 index 00000000..67511de2 --- /dev/null +++ b/api/src/OpenTelemetry/Attribute/Attribute.hs @@ -0,0 +1,174 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TypeFamilies #-} + +{- | +Module : OpenTelemetry.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 +Maintainer : Ian Duncan +Stability : experimental +Portability : non-portable (GHC extensions) +-} +module OpenTelemetry.Attribute.Attribute ( + Attribute (..), + IsAttribute (..), + PrimitiveAttribute (..), + IsPrimitiveAttribute (..), +) where + +import Data.Data (Data) +import Data.Hashable (Hashable) +import Data.Int (Int64) +import qualified Data.List as L +import Data.String (IsString (..)) +import Data.Text (Text) +import GHC.Generics (Generic) +import Prelude hiding (lookup, map) + + +-- | Convert a Haskell value to a 'PrimitiveAttribute' value. +class IsPrimitiveAttribute a where + toPrimitiveAttribute :: a -> PrimitiveAttribute + fromPrimitiveAttribute :: PrimitiveAttribute -> Maybe a + + +{- | An attribute represents user-provided metadata about a span, link, or event. + + Telemetry tools may use this data to support high-cardinality querying, visualization + in waterfall diagrams, trace sampling decisions, and more. +-} +data Attribute + = -- | An attribute representing a single primitive value + AttributeValue PrimitiveAttribute + | -- | An attribute representing an array of primitive values. + -- + -- All values in the array MUST be of the same primitive attribute type. + AttributeArray [PrimitiveAttribute] + deriving stock (Read, Show, Eq, Ord, Data, Generic) + deriving anyclass (Hashable) + + +{- | Create a `TextAttribute` from the string value. + + @since 0.0.2.1 +-} +instance IsString PrimitiveAttribute where + fromString = TextAttribute . fromString + + +{- | Create a `TextAttribute` from the string value. + + @since 0.0.2.1 +-} +instance IsString Attribute where + fromString = AttributeValue . fromString + + +data PrimitiveAttribute + = TextAttribute Text + | BoolAttribute Bool + | DoubleAttribute Double + | IntAttribute Int64 + deriving stock (Read, Show, Eq, Ord, Data, Generic) + deriving anyclass (Hashable) + + +{- | Convert a Haskell value to an 'Attribute' value. + + For most values, you can define an instance of 'IsPrimitiveAttribute' and use the default 'toAttribute' implementation: + + @ + + data Foo = Foo + + instance IsPrimitiveAttribute Foo where + toPrimitiveAttribute Foo = TextAttribute "Foo" + instance IsAttribute foo + + @ +-} +class IsAttribute a where + toAttribute :: a -> Attribute + default toAttribute :: (IsPrimitiveAttribute a) => a -> Attribute + toAttribute = AttributeValue . toPrimitiveAttribute + fromAttribute :: Attribute -> Maybe a + default fromAttribute :: (IsPrimitiveAttribute a) => Attribute -> Maybe a + fromAttribute (AttributeValue v) = fromPrimitiveAttribute v + fromAttribute _ = Nothing + + +instance IsPrimitiveAttribute PrimitiveAttribute where + toPrimitiveAttribute = id + fromPrimitiveAttribute = Just + + +instance IsAttribute PrimitiveAttribute where + toAttribute = AttributeValue + fromAttribute (AttributeValue v) = Just v + fromAttribute _ = Nothing + + +instance IsPrimitiveAttribute Text where + toPrimitiveAttribute = TextAttribute + fromPrimitiveAttribute (TextAttribute v) = Just v + fromPrimitiveAttribute _ = Nothing + + +instance IsAttribute Text + + +instance IsPrimitiveAttribute Bool where + toPrimitiveAttribute = BoolAttribute + fromPrimitiveAttribute (BoolAttribute v) = Just v + fromPrimitiveAttribute _ = Nothing + + +instance IsAttribute Bool + + +instance IsPrimitiveAttribute Double where + toPrimitiveAttribute = DoubleAttribute + fromPrimitiveAttribute (DoubleAttribute v) = Just v + fromPrimitiveAttribute _ = Nothing + + +instance IsAttribute Double + + +instance IsPrimitiveAttribute Int64 where + toPrimitiveAttribute = IntAttribute + fromPrimitiveAttribute (IntAttribute v) = Just v + fromPrimitiveAttribute _ = Nothing + + +instance IsAttribute Int64 + + +instance IsPrimitiveAttribute Int where + toPrimitiveAttribute = IntAttribute . fromIntegral + fromPrimitiveAttribute (IntAttribute v) = Just $ fromIntegral v + fromPrimitiveAttribute _ = Nothing + + +instance IsAttribute Int + + +instance IsAttribute Attribute where + toAttribute = id + fromAttribute = Just + + +instance (IsPrimitiveAttribute a) => IsAttribute [a] where + toAttribute = AttributeArray . L.map toPrimitiveAttribute + fromAttribute (AttributeArray arr) = traverse fromPrimitiveAttribute arr + fromAttribute _ = Nothing diff --git a/api/src/OpenTelemetry/Attribute/AttributeCollection.hs b/api/src/OpenTelemetry/Attribute/AttributeCollection.hs new file mode 100644 index 00000000..0ba51e76 --- /dev/null +++ b/api/src/OpenTelemetry/Attribute/AttributeCollection.hs @@ -0,0 +1,169 @@ +{-# 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 new file mode 100644 index 00000000..04d37eb1 --- /dev/null +++ b/api/src/OpenTelemetry/Attribute/Attributes.hs @@ -0,0 +1,115 @@ +{-# 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/Attribute/Key.hs b/api/src/OpenTelemetry/Attribute/Key.hs new file mode 100644 index 00000000..27d66185 --- /dev/null +++ b/api/src/OpenTelemetry/Attribute/Key.hs @@ -0,0 +1,904 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} + +{- | +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.Key ( + Key (..), + forget, + + -- * Semantic conventions + -- $semanticConversions + + -- ** Attributes Registry + -- $attributesRegistry + + -- *** Cloud + -- $tbd + + -- *** Code + -- $code + code_column, + code_filepath, + code_function, + code_lineno, + code_namespace, + + -- *** Container + -- $container + container_command, + container_commandArgs, + container_commandLine, + container_id, + container_image_id, + container_image_name, + container_image_repoDigests, + container_image_tags, + container_name, + container_runtime, + + -- *** HTTP + -- $http + http_request_body_size, + http_request_method, + http_request_methodOriginal, + http_request_resendCount, + http_response_body_size, + http_response_statusCode, + http_route, + + -- *** Messaging + -- $tbd + + -- *** Network + -- $network + network_carrier_icc, + network_carrier_mcc, + network_carrier_mnc, + network_carrier_name, + network_connection_subtype, + network_connection_type, + network_local_address, + network_local_port, + network_peer_address, + network_peer_port, + network_protocol_name, + network_protocol_version, + network_transport, + network_type, + + -- *** Open Container Initiative + -- $tbd + + -- *** RPC + -- $tbd + + -- *** Thread + -- $tbd + + -- *** URL + -- $tbd + + -- *** User agent + -- $tbd + + -- ** General Attributes + -- $generalAttributes + + -- *** Server, client and shared network attributes + -- $serverClientSharedNetworkAttributes + server_address, + server_port, + client_address, + client_port, + + -- *** Source and destination attributes + -- $sourceAndDestinationAttributes + source_address, + source_port, + destination_address, + destination_port, + + -- *** General remote service attributes + -- $generalRemoteServiceAttributes + peer_service, + + -- *** General identity attributes + -- $generalIdentityAttributes + enduser_id, + enduser_role, + enduser_scope, + + -- ** Event Attributes + -- $eventAttributes + + -- *** General event attributes + -- $generalEventAttributes + event_domain, + event_name, + + -- ** General Logs Attributes + -- $generalLogsAttributes + + -- *** General log identification attributes + -- $generalLogIdentificationAttributes + log_record_uid, + + -- *** Log media + -- $logMedia + log_file_name, + log_file_nameResolved, + log_file_path, + log_file_pathResolved, + log_iostream, + + -- ** Session + + -- *** Attributes + session_id, + session_previousId, + + -- ** Tracing Compatibility Components + + -- *** OpenTracing + opentracing_refType, + + -- ** Cloud Providers + + -- *** AWS SDK + -- $tbd + + -- ** CloudEvents + + -- *** CloudEvents Spans + -- $tbd + + -- ** Database Calls and Systems + + -- *** AWS DynamoDB + -- $tbd + + -- *** Cassandra + -- $tbd + + -- *** Database Client Calls + -- $databaseClientCalls + db_connectionString, + db_system, + db_user, + db_name, + db_operation, + db_statement, + + -- *** Microsoft Cosmos DB + -- $tbd + + -- *** CouchDB + -- $tbd + + -- *** Elasticsearch + -- $tbd + + -- *** GraphQL Server + -- $tbd + + -- *** HBase + -- $tbd + + -- *** Database Metrics + -- $tbd + + -- *** MongoDB + -- $tbd + + -- *** MSSQL + -- $tbd + + -- *** Redis + -- $redis + db_redis_databaseIndex, + + -- *** SQL Database + -- $sqlDatabase + db_sql_table, + + -- ** Exceptions + + -- *** Exceptions in logs + -- $tbd + + -- *** Exceptions in spans + -- $tbd + + -- ** Function-as-a-Service + -- $tbd + + -- ** Feature Flags + -- $tbd + + -- ** HTTP + + -- *** HTTP metrics + -- $httpMetrics + error_type, + + -- *** HTTP spans + -- $httpSpans + + -- ** Messaging Systems + -- $tbd + + -- ** Mobile Platform + -- $tbd + + -- ** Object Stores + -- $tbd + + -- ** Resource + -- $tbd + + -- *** Function as a Service + -- $faas + faas_instance, + faas_maxMemory, + faas_name, + faas_version, + + -- ** RPC + -- $tbd + + -- ** Runtime Environment + -- $tbd + + -- ** System + -- $tbd + + -- ** URL + -- $tbd +) where + +import Data.Int (Int64) +import Data.String (IsString (..)) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import OpenTelemetry.Attribute.Attribute (Attribute) + + +{-# ANN module ("HLint: ignore Use camelCase" :: String) #-} + + +newtype Key a = Key {unkey :: Text} deriving stock (Show, Eq, Ord, Generic) + + +-- | Raise an error if the string is empty. +instance IsString (Key a) where + fromString "" = error "Key cannot be empty" + fromString s = Key $ T.pack s + + +forget :: Key a -> Key Attribute +forget = Key . unkey + + +{- $semanticConversions + +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/ +-} + + +{- $attributesRegistry + +The attributes registry is the place where attributes are defined. + +Specification: https://opentelemetry.io/docs/specs/semconv/attributes-registry/ +-} + + +{- $code +These attributes allow to report this unit of code and therefore to provide more context about the telemetry data. + +Specification: https://opentelemetry.io/docs/specs/semconv/attributes-registry/code/ +-} + + +{- | The column number in @code.filepath@ best representing the operation. +It SHOULD point within the code unit named in @code.function@. +-} +code_column :: Key Int64 +code_column = "code.column" + + +-- | The source code file name that identifies the code unit as uniquely as possible (preferably an absolute file path). +code_filepath :: Key Text +code_filepath = "code.filepath" + + +-- | The method or function name, or equivalent (usually rightmost part of the code unit's name). +code_function :: Key Text +code_function = "code.function" + + +{- | The line number in @code.filepath@ best representing the operation. +It SHOULD point within the code unit named in @code.function@. +-} +code_lineno :: Key Int64 +code_lineno = "code.lineno" + + +{- | The “namespace” within which @code.function@ is defined. +Usually the qualified class or module name, such that @code.namespace@ + some separator + @code.function@ form a unique identifier for the code unit. +-} +code_namespace :: Key Text +code_namespace = "code.namespace" + + +{- $container +Specification: https://opentelemetry.io/docs/specs/semconv/attributes-registry/container/ +-} + + +-- | The command used to run the container (i.e. the command name). +container_command :: Key Text +container_command = "container.command" + + +-- | All the command arguments (including the command\/executable itself) run by the container. +container_commandArgs :: Key [Text] +container_commandArgs = "container.command_args" + + +-- | The full command run by the container as a single string representing the full command. +container_commandLine :: Key Text +container_commandLine = "container.command_line" + + +{- | Container ID. Usually a UUID, as for example used to (identify Docker containers)[https://docs.docker.com/engine/reference/run/#container-identification]. +The UUID might be abbreviated. +-} +container_id :: Key Text +container_id = "container.id" + + +-- | Runtime specific image identifier. Usually a hash algorithm followed by a UUID. +container_image_id :: Key Text +container_image_id = "container.image.id" + + +-- | Name of the image the container was built on. +container_image_name :: Key Text +container_image_name = "container.image.name" + + +-- | Repo digests of the container image as provided by the container runtime. +container_image_repoDigests :: Key [Text] +container_image_repoDigests = "container.image.repo_digests" + + +{- | Container image tags. An example can be found in [Docker Image Inspect](https://docs.docker.com/engine/api/v1.43/#tag/Image/operation/ImageInspect). +Should be only the @@ section of the full name for example from @registry.example.com/my-org/my-image:@. +-} +container_image_tags :: Key [Text] +container_image_tags = "container.image.tags" + + +-- | Container name used by container runtime. +container_name :: Key Text +container_name = "container.name" + + +-- | The container runtime managing this container. +container_runtime :: Key Text +container_runtime = "container.runtime" + + +{- $http +Specification: https://opentelemetry.io/docs/specs/semconv/attributes-registry/http/ +-} + + +-- | The size of the request payload body in bytes. +http_request_body_size :: Key Int64 +http_request_body_size = "http.request.body.size" + + +-- | HTTP request method. +http_request_method :: Key Text +http_request_method = "http.request.method" + + +-- | Original HTTP method sent by the client in the request line. +http_request_methodOriginal :: Key Text +http_request_methodOriginal = "http.request.method_original" + + +-- | The ordinal number of request resending attempt (for any reason, including redirects). +http_request_resendCount :: Key Int64 +http_request_resendCount = "http.request.resend_count" + + +-- | The size of the response payload body in bytes. +http_response_body_size :: Key Int64 +http_response_body_size = "http.response.body.size" + + +-- | [HTTP response status code](https://tools.ietf.org/html/rfc7231#section-6). +http_response_statusCode :: Key Int64 +http_response_statusCode = "http.response.status_code" + + +-- | The matched route, that is, the path template in the format used by the respective server framework. +http_route :: Key Text +http_route = "http.route" + + +-- | The ISO 3166-1 alpha-2 2-character country code associated with the mobile carrier network. +network_carrier_icc :: Key Text +network_carrier_icc = "network.carrier.icc" + + +-- | The mobile carrier country code. +network_carrier_mcc :: Key Text +network_carrier_mcc = "network.carrier.mcc" + + +-- | The mobile carrier network code. +network_carrier_mnc :: Key Text +network_carrier_mnc = "network.carrier.mnc" + + +-- | The name of the mobile carrier. +network_carrier_name :: Key Text +network_carrier_name = "network.carrier.name" + + +-- | This describes more details regarding the @network.connection.type@. +network_connection_subtype :: Key Text +network_connection_subtype = "network.connection.subtype" + + +-- | The internet connection type. +network_connection_type :: Key Text +network_connection_type = "network.connection.type" + + +-- | Local address of the network connection - IP address or Unix domain socket name. +network_local_address :: Key Text +network_local_address = "network.local.address" + + +-- | Local port number of the network connection. +network_local_port :: Key Int64 +network_local_port = "network.local.port" + + +-- | Peer address of the network connection - IP address or Unix domain socket name. +network_peer_address :: Key Text +network_peer_address = "network.peer.address" + + +-- | Peer port number of the network connection. +network_peer_port :: Key Int64 +network_peer_port = "network.peer.port" + + +-- | OSI application layer or non-OSI equivalent. +network_protocol_name :: Key Text +network_protocol_name = "network.protocol.name" + + +-- | Version of the protocol specified in @network.protocol.name@. +network_protocol_version :: Key Text +network_protocol_version = "network.protocol.version" + + +-- | OSI transport layer or inter-process communication method. +network_transport :: Key Text +network_transport = "network.transport" + + +-- | OSI network layer or non-OSI equivalent. +network_type :: Key Text +network_type = "network.type" + + +{- $generalAttributes +The attributes described in this section are not specific to a particular operation but rather generic. They may be used in any Span they apply to. Particular operations may refer to or require some of these attributes. + +Specification: https://opentelemetry.io/docs/specs/semconv/general/attributes/ +-} + + +{- $serverClientSharedNetworkAttributes +These attributes may be used to describe the client and server in a connection-based network interaction where there is one side that initiates the connection (the client is the side that initiates the connection). This covers all TCP network interactions since TCP is connection-based and one side initiates the connection (an exception is made for peer-to-peer communication over TCP where the “user-facing” surface of the protocol \/ API does not expose a clear notion of client and server). This also covers UDP network interactions where one side initiates the interaction, e.g. QUIC (HTTP\/3) and DNS. +-} + + +{- | Server domain name if available without reverse DNS lookup; otherwise, IP address or Unix domain socket name. + +Recomended. +-} +server_address :: Key Text +server_address = "server.address" + + +{- | Server port number. + +Recomended. +-} +server_port :: Key Int64 +server_port = "server.port" + + +{- | Client address - domain name if available without reverse DNS lookup; otherwise, IP address or Unix domain socket name. + +Recomended. +-} +client_address :: Key Text +client_address = "client.address" + + +{- | Client port number. + +Recomended. +-} +client_port :: Key Int64 +client_port = "client.port" + + +{- $sourceAndDestinationAttributes +These attributes may be used to describe the sender and receiver of a network exchange\/packet. These should be used when there is no client\/server relationship between the two sides, or when that relationship is unknown. This covers low-level network interactions (e.g. packet tracing) where you don’t know if there was a connection or which side initiated it. This also covers unidirectional UDP flows and peer-to-peer communication where the “user-facing” surface of the protocol \/ API does not expose a clear notion of client and server. +-} + + +{- | Source address - domain name if available without reverse DNS lookup; otherwise, IP address or Unix domain socket name. + +Recomended. +-} +source_address :: Key Text +source_address = "source.address" + + +{- | Source port number. + +Recomended. +-} +source_port :: Key Int64 +source_port = "source.port" + + +{- | Destination address - domain name if available without reverse DNS lookup; otherwise, IP address or Unix domain socket name. + +Recomended. +-} +destination_address :: Key Text +destination_address = "destination.address" + + +{- | Destination port number. + +Recomended. +-} +destination_port :: Key Int64 +destination_port = "destination.port" + + +{- $generalRemoteServiceAttributes +This attribute may be used for any operation that accesses some remote service. Users can define what the name of a service is based on their particular semantics in their distributed system. Instrumentations SHOULD provide a way for users to configure this name. +-} + + +{- | The @service.name@ of the remote service. SHOULD be equal to the actual @service.name@ resource attribute of the remote service if any. + +Recomended. +-} +peer_service :: Key Text +peer_service = "peer.service" + + +{- | Username or client_id extracted from the access token or [Authorization](https://tools.ietf.org/html/rfc7235#section-4.2) header in the inbound request from outside the system. + +Recomended. +-} +enduser_id :: Key Text +enduser_id = "enduser.id" + + +{- | Actual\/assumed role the client is making the request under extracted from token or application security context. + +Recomended. +-} +enduser_role :: Key Text +enduser_role = "enduser.role" + + +{- | Scopes or granted authorities the client currently possesses extracted from token or application security context. The value would come from the scope associated with an [OAuth 2.0 Access](https://tools.ietf.org/html/rfc6749#section-3.3) Token or an attribute value in a [SAML 2.0 Assertion](http://docs.oasis-open.org/security/saml/Post2.0/sstc-saml-tech-overview-2.0.html). + +Recomended. +-} +enduser_scope :: Key Text +enduser_scope = "enduser.scope" + + +{- $eventAttributes +Specification: https://opentelemetry.io/docs/specs/semconv/general/events/ +-} + + +{- $generalLogIdentificationAttributes +Events are recorded as LogRecords that are shaped in a special way: Event LogRecords have the attributes event.domain and event.name (and possibly other LogRecord attributes). +-} + + +{- | The domain identifies the business context for the events. + +Required. +-} +event_domain :: Key Text +event_domain = "event.domain" + + +{- | The name identifies the event. + +Required. +-} +event_name :: Key Text +event_name = "event.name" + + +{- $generalLogsAttributes +The attributes described in this section are rather generic. They may be used in any Log Record they apply to. + +Specification: https://opentelemetry.io/docs/specs/semconv/general/logs/ +-} + + +{- | A unique identifier for the Log Record. + +Opt-In. +-} +log_record_uid :: Key Text +log_record_uid = "log.record.uid" + + +{- $logMedia +This section describes attributes for log media in OpenTelemetry. Log media are mechanisms by which logs are transmitted. Types of media include files, streams, network protocols, and os-specific logging services such as journald and Windows Event Log. +-} + + +{- | The basename of the file. + +Recommended. +-} +log_file_name :: Key Text +log_file_name = "log.file.name" + + +{- | The basename of the file, with symlinks resolved. + +Opt-In. +-} +log_file_nameResolved :: Key Text +log_file_nameResolved = "log.file.name_resolved" + + +{- | The full path to the file. + +Opt-In. +-} +log_file_path :: Key Text +log_file_path = "log.file.path" + + +{- | The full path to the file, with symlinks resolved. + +Opt-In. +-} +log_file_pathResolved :: Key Text +log_file_pathResolved = "log.file.path_resolved" + + +{- | The stream associated with the log. + +Opt-In. +-} +log_iostream :: Key Text +log_iostream = "log.iostream" + + +{- | A unique id to identify a session. + +Opt-In. +-} +session_id :: Key Text +session_id = "session.id" + + +{- | The previous @session.id@ for this user, when known. + +Opt-In. +-} +session_previousId :: Key Text +session_previousId = "session.previous_id" + + +{- | Parent-child reference type. + +Recommended. +-} +opentracing_refType :: Key Text +opentracing_refType = "opentracing.ref_type" + + +{- $databaseClientCalls +Span kind: MUST always be CLIENT. + +The span name SHOULD be set to a low cardinality value representing the statement executed on the database. It MAY be a stored procedure name (without arguments), DB statement without variable arguments, operation name, etc. Since SQL statements may have very high cardinality even without arguments, SQL spans SHOULD be named the following way, unless the statement is known to be of low cardinality: @db.operation@ @db.name.db.sql.table@, provided that @db.operation@ and @db.sql.table@ are available. If @db.sql.table@ is not available due to its semantics, the span SHOULD be named @db.operation@ @db.name@. It is not recommended to attempt any client-side parsing of @db.statement@ just to get these properties, they should only be used if the library being instrumented already provides them. When it’s otherwise impossible to get any meaningful span name, @db.name@ or the tech-specific database name MAY be used. + +Specification: https://opentelemetry.io/docs/specs/semconv/database/database-spans/ +-} + + +{- | The connection string used to connect to the database. It is recommended to remove embedded credentials. + +Recommended. +-} +db_connectionString :: Key Text +db_connectionString = "db.connection_string" + + +{- | An identifier for the database management system (DBMS) product being used. See the spec. for a list of well-known identifiers. + +Required. +-} +db_system :: Key Text +db_system = "db.system" + + +{- | Username for accessing the database. + +Recomended. +-} +db_user :: Key Text +db_user = "db.user" + + +{- +db.name string This attribute is used to report the name of the database being accessed. For commands that switch the database, this should be set to the target database (even if the command fails). [1] customers; main Conditionally Required: If applicable. +db.operation string The name of the operation being executed, e.g. the MongoDB command name such as findAndModify, or the SQL keyword. [2] findAndModify; HMSET; SELECT Conditionally Required: If db.statement is not applicable. +db.statement string The database statement being executed. SELECT * FROM wuser_table; SET mykey "WuValue" Recommended: [3] +-} + +{- | This attribute is used to report the name of the database being accessed. For commands that switch the database, this should be set to the target database (even if the command fails). + +Conditionally Required: If applicable. +-} +db_name :: Key Text +db_name = "db.name" + + +{- | The name of the operation being executed, e.g. the [MongoDB command name](https://docs.mongodb.com/manual/reference/command/#database-operations) such as @findAndModify@, or the SQL keyword. + +Conditionally Required: If @db.statement@ is not applicable. +-} +db_operation :: Key Text +db_operation = "db.operation" + + +{- | The database statement being executed. + +Recommended. +-} +db_statement :: Key Text +db_statement = "db.statement" + + +{- $redis +The Semantic Conventions for [Redis](https://redis.com/) extend and override the [Database Semantic Conventions](https://opentelemetry.io/docs/specs/semconv/database/database-spans/) that describe common database operations attributes in addition to the Semantic Conventions described on this page. + +@db.system@ MUST be set to @"redis"@. +-} + + +{- | The index of the database being accessed as used in the [@SELECT@ command](https://redis.io/commands/select), provided as an integer. To be used instead of the generic @db.name@ attribute.} + +Conditionally Required: If other than the default database (@0@). +-} +db_redis_databaseIndex :: Key Int64 +db_redis_databaseIndex = "db.redis.database_index" + + +{- $sqlDatabase +The SQL databases Semantic Conventions extend and override the [Database Semantic Conventions](https://opentelemetry.io/docs/specs/semconv/database/database-spans/) that describe common database operations attributes in addition to the Semantic Conventions described on this page. +-} + + +{- | The name of the primary table that the operation is acting upon, including the database name (if applicable). + +Recommended. +-} +db_sql_table :: Key Text +db_sql_table = "db.sql.table" + + +{- $httpMetrics +The conventions described in this section are HTTP specific. When HTTP operations occur, metric events about those operations will be generated and reported to provide insight into the operations. By adding HTTP attributes to metric events it allows for finely tuned filtering. + +Specification: https://opentelemetry.io/docs/specs/semconv/http/http-metrics/ +-} + + +{- | Describes a class of error the operation ended with. + +Conditionally Required: If request has ended with an error. +-} +error_type :: Key Text +error_type = "error.type" + + +{- $faas +Specification: https://opentelemetry.io/docs/specs/semconv/resource/faas/ +-} + + +{- +faas.instance string The execution environment ID as a string, that will be potentially reused for other invocations to the same function/function version. [2] 2021/06/28/[$LATEST]2f399eb14537447da05ab2a2e39309de Recommended +faas.max_memory int The amount of memory available to the serverless function converted to Bytes. [3] 134217728 Recommended +faas.name string The name of the single function that this runtime instance executes. [4] my-function; myazurefunctionapp/some-function-name Required +faas.version string The immutable version of the function being executed. [5] 26; pinkfroid-00002 Recommended +-} + +{- | The execution environment ID as a string, that will be potentially reused for other invocations to the same function\/function version. + +Recomended. +-} +faas_instance :: Key Text +faas_instance = "faas.instance" + + +{- | The amount of memory available to the serverless function converted to Bytes. + +Recomended. +-} +faas_maxMemory :: Key Int64 +faas_maxMemory = "faas.max_memory" + + +{- | The name of the single function that this runtime instance executes. + +Required. +-} +faas_name :: Key Text +faas_name = "faas.name" + + +{- | The immutable version of the function being executed. + +Recomended. +-} +faas_version :: Key Text +faas_version = "faas.version" + + +{- $tbd + +To be done. +-} diff --git a/api/src/OpenTelemetry/Attributes.hs b/api/src/OpenTelemetry/Attributes.hs deleted file mode 100644 index dc41a094..00000000 --- a/api/src/OpenTelemetry/Attributes.hs +++ /dev/null @@ -1,274 +0,0 @@ -{-# 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. --} -module OpenTelemetry.Attributes ( - Attributes, - emptyAttributes, - addAttribute, - addAttributes, - getAttributes, - lookupAttribute, - Attribute (..), - ToAttribute (..), - PrimitiveAttribute (..), - ToPrimitiveAttribute (..), - - -- * 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.Int (Int64) -import Data.String (IsString (..)) -import Data.Text (Text) -import qualified Data.Text as T -import GHC.Generics (Generic) - - -{- | Default attribute limits used in the global attribute limit configuration if no environment variables are set. - - Values: - - - 'attributeCountLimit': @Just 128@ - - 'attributeLengthLimit': 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) - - -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 #-} - - -addAttributes :: ToAttribute a => AttributeLimits -> Attributes -> H.HashMap Text a -> 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 $ H.map toAttribute 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 -> (Int, H.HashMap Text Attribute) -getAttributes Attributes {..} = (attributesCount, attributes) - - -lookupAttribute :: Attributes -> Text -> Maybe Attribute -lookupAttribute Attributes {..} k = H.lookup 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 dropped. - , 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 - - --- | Convert a Haskell value to a 'PrimitiveAttribute' value. -class ToPrimitiveAttribute a where - toPrimitiveAttribute :: a -> PrimitiveAttribute - - -{- | An attribute represents user-provided metadata about a span, link, or event. - - Telemetry tools may use this data to support high-cardinality querying, visualization - in waterfall diagrams, trace sampling decisions, and more. --} -data Attribute - = -- | An attribute representing a single primitive value - AttributeValue PrimitiveAttribute - | -- | An attribute representing an array of primitive values. - -- - -- All values in the array MUST be of the same primitive attribute type. - AttributeArray [PrimitiveAttribute] - deriving stock (Read, Show, Eq, Ord, Data, Generic) - deriving anyclass (Hashable) - - -{- | Create a `TextAttribute` from the string value. - - @since 0.0.2.1 --} -instance IsString PrimitiveAttribute where - fromString = TextAttribute . fromString - - -{- | Create a `TextAttribute` from the string value. - - @since 0.0.2.1 --} -instance IsString Attribute where - fromString = AttributeValue . fromString - - -data PrimitiveAttribute - = TextAttribute Text - | BoolAttribute Bool - | DoubleAttribute Double - | IntAttribute Int64 - deriving stock (Read, Show, Eq, Ord, Data, Generic) - deriving anyclass (Hashable) - - -{- | Convert a Haskell value to an 'Attribute' value. - - For most values, you can define an instance of 'ToPrimitiveAttribute' and use the default 'toAttribute' implementation: - - @ - - data Foo = Foo - - instance ToPrimitiveAttribute Foo where - toPrimitiveAttribute Foo = TextAttribute "Foo" - instance ToAttribute foo - - @ --} -class ToAttribute a where - toAttribute :: a -> Attribute - default toAttribute :: (ToPrimitiveAttribute a) => a -> Attribute - toAttribute = AttributeValue . toPrimitiveAttribute - - -instance ToPrimitiveAttribute PrimitiveAttribute where - toPrimitiveAttribute = id - - -instance ToAttribute PrimitiveAttribute where - toAttribute = AttributeValue - - -instance ToPrimitiveAttribute Text where - toPrimitiveAttribute = TextAttribute - - -instance ToAttribute Text - - -instance ToPrimitiveAttribute Bool where - toPrimitiveAttribute = BoolAttribute - - -instance ToAttribute Bool - - -instance ToPrimitiveAttribute Double where - toPrimitiveAttribute = DoubleAttribute - - -instance ToAttribute Double - - -instance ToPrimitiveAttribute Int64 where - toPrimitiveAttribute = IntAttribute - - -instance ToAttribute Int64 - - -instance ToPrimitiveAttribute Int where - toPrimitiveAttribute = IntAttribute . fromIntegral - - -instance ToAttribute Int - - -instance ToAttribute Attribute where - toAttribute = id - - -instance (ToPrimitiveAttribute a) => ToAttribute [a] where - toAttribute = AttributeArray . map toPrimitiveAttribute - - -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/Internal/Trace/Types.hs b/api/src/OpenTelemetry/Internal/Trace/Types.hs index 432cfef0..3fb61086 100644 --- a/api/src/OpenTelemetry/Internal/Trace/Types.hs +++ b/api/src/OpenTelemetry/Internal/Trace/Types.hs @@ -14,7 +14,6 @@ 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 (..)) @@ -23,7 +22,8 @@ import Data.Vector (Vector) import Data.Word (Word8) import GHC.Generics import Network.HTTP.Types (RequestHeaders, ResponseHeaders) -import OpenTelemetry.Attributes +import OpenTelemetry.Attribute.AttributeCollection +import OpenTelemetry.Attribute.Attributes (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 :: H.HashMap Text Attribute + , linkAttributes :: Attributes -- ^ 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 :: Attributes + , frozenLinkAttributes :: AttributeCollection -- ^ 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 :: H.HashMap Text Attribute + , attributes :: Attributes -- ^ 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 :: Attributes + , spanAttributes :: AttributeCollection , 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 :: H.HashMap Text Attribute + , newEventAttributes :: Attributes -- ^ 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 :: Attributes + , eventAttributes :: AttributeCollection -- ^ 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, H.HashMap Text Attribute, TraceState) + , shouldSample :: Context -> TraceId -> Text -> SpanArguments -> IO (SamplingResult, Attributes, TraceState) } diff --git a/api/src/OpenTelemetry/Logging/Core.hs b/api/src/OpenTelemetry/Logging/Core.hs index a1682eef..d591e826 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.Attributes (Attribute) +import OpenTelemetry.Attribute (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 d209ffe5..5ef12bf1 100644 --- a/api/src/OpenTelemetry/Resource.hs +++ b/api/src/OpenTelemetry/Resource.hs @@ -45,9 +45,8 @@ module OpenTelemetry.Resource ( import Data.Maybe (catMaybes) import Data.Proxy (Proxy (..)) -import Data.Text (Text) import GHC.TypeLits -import OpenTelemetry.Attributes +import OpenTelemetry.Attribute {- | A set of attributes created from one or more resources. @@ -65,7 +64,7 @@ import OpenTelemetry.Attributes 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 Attributes +newtype Resource (schema :: Maybe Symbol) = Resource AttributeCollection {- | Utility function to create a resource from a list @@ -73,22 +72,22 @@ newtype Resource (schema :: Maybe Symbol) = Resource Attributes @since 0.0.1.0 -} -mkResource :: [Maybe (Text, Attribute)] -> Resource r +mkResource :: [Maybe (Key Attribute, Attribute)] -> Resource r mkResource = Resource . unsafeAttributesFromListIgnoringLimits . catMaybes {- | Utility function to convert a required resource attribute into the format needed for 'mkResource'. -} -(.=) :: (ToAttribute a) => Text -> a -> Maybe (Text, Attribute) -k .= v = Just (k, toAttribute v) +(.=) :: (IsAttribute a) => Key a -> a -> Maybe (Key Attribute, Attribute) +(Key k) .= v = Just (Key k, toAttribute v) {- | Utility function to convert an optional resource attribute into the format needed for 'mkResource'. -} -(.=?) :: (ToAttribute a) => Text -> Maybe a -> Maybe (Text, Attribute) -k .=? mv = (\k' v -> (k', toAttribute v)) k <$> mv +(.=?) :: (IsAttribute a) => Key a -> Maybe a -> Maybe (Key Attribute, Attribute) +k .=? mv = (\(Key k') v -> (Key k', toAttribute v)) k <$> mv instance Semigroup (Resource s) where @@ -174,7 +173,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 :: Attributes + , materializedResourcesAttributes :: AttributeCollection } deriving (Show) @@ -200,5 +199,5 @@ getMaterializedResourcesSchema = materializedResourcesSchema @since 0.0.1.0 -} -getMaterializedResourcesAttributes :: MaterializedResources -> Attributes +getMaterializedResourcesAttributes :: MaterializedResources -> AttributeCollection getMaterializedResourcesAttributes = materializedResourcesAttributes diff --git a/api/src/OpenTelemetry/Trace/Core.hs b/api/src/OpenTelemetry/Trace/Core.hs index 69884d54..0eb06b35 100644 --- a/api/src/OpenTelemetry/Trace/Core.hs +++ b/api/src/OpenTelemetry/Trace/Core.hs @@ -108,9 +108,12 @@ module OpenTelemetry.Trace.Core ( OpenTelemetry.Trace.Core.addAttributes, spanGetAttributes, A.Attribute (..), - A.ToAttribute (..), + A.IsAttribute (..), A.PrimitiveAttribute (..), - A.ToPrimitiveAttribute (..), + A.IsPrimitiveAttribute (..), + A.Key (..), + A.Attributes, + A.AttributeCollection, -- ** Recording error information recordException, @@ -148,7 +151,6 @@ 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) @@ -158,7 +160,10 @@ import qualified Data.Vector as V import Data.Word (Word64) import GHC.Stack import Network.HTTP.Types -import qualified OpenTelemetry.Attributes as A +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 OpenTelemetry.Common import OpenTelemetry.Context import OpenTelemetry.Context.ThreadLocal @@ -203,7 +208,7 @@ createSpan :: -- | The created span. m Span createSpan t c n args@SpanArguments {attributes} = - createSpanWithoutCallStack t c n args {attributes = H.union attributes $ makeCodeAttributes callStack} + createSpanWithoutCallStack t c n args {attributes = A.union attributes $ makeCodeAttributes callStack} -- | The same thing as 'createSpan', except that it does not have a 'HasCallStack' constraint. @@ -272,7 +277,7 @@ createSpanWithoutCallStack t ctxt n args@SpanArguments {..} = liftIO $ do A.addAttributes (limitBy t spanAttributeCountLimit) A.emptyAttributes - (H.unions [additionalInfo, attrs, attributes]) + (A.unions [additionalInfo, attrs, attributes]) , spanLinks = let limitedLinks = fromMaybe 128 (linkCountLimit $ tracerProviderSpanLimits $ tracerProvider t) in frozenBoundedCollection limitedLinks $ fmap freezeLink links @@ -364,12 +369,12 @@ inSpan'' t cs n args f = (\(_, s) -> f s) -makeCodeAttributes :: CallStack -> H.HashMap Text A.Attribute +makeCodeAttributes :: CallStack -> A.Attributes makeCodeAttributes callStack' = case getCallStack callStack' of - [] -> H.empty + [] -> A.empty (_, loc) : rest -> - H.union + A.union [ ("code.namespace", A.toAttribute $ T.pack $ srcLocModule loc) , ("code.filepath", A.toAttribute $ T.pack $ srcLocFile loc) , ("code.lineno", A.toAttribute $ srcLocStartLine loc) @@ -414,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.ToAttribute a) => + (MonadIO m, A.IsAttribute a) => -- | Span to add the attribute to Span -> -- | Attribute name - Text -> + A.Key a -> -- | Attribute value a -> m () @@ -441,7 +446,7 @@ addAttribute (Dropped _) _ _ = pure () @since 0.0.1.0 -} -addAttributes :: MonadIO m => Span -> H.HashMap Text A.Attribute -> m () +addAttributes :: MonadIO m => Span -> A.Attributes -> m () addAttributes (Span s) attrs = liftIO $ modifyIORef' s $ \(!i) -> i { spanAttributes = @@ -553,7 +558,7 @@ endSpan (Dropped _) _ = pure () @since 0.0.1.0 -} -recordException :: (MonadIO m, Exception e) => Span -> H.HashMap Text A.Attribute -> Maybe Timestamp -> e -> m () +recordException :: (MonadIO m, Exception e) => Span -> A.Attributes -> Maybe Timestamp -> e -> m () recordException s attrs ts e = liftIO $ do cs <- whoCreated e let message = T.pack $ show e @@ -561,7 +566,7 @@ recordException s attrs ts e = liftIO $ do NewEvent { newEventName = "exception" , newEventAttributes = - H.union + A.union attrs [ ("exception.type", A.toAttribute $ T.pack $ show $ typeOf e) , ("exception.message", A.toAttribute message) @@ -610,7 +615,7 @@ wrapSpanContext = FrozenSpan using it to copy / otherwise use the data to further enrich instrumentation. -} -spanGetAttributes :: (MonadIO m) => Span -> m A.Attributes +spanGetAttributes :: (MonadIO m) => Span -> m A.AttributeCollection 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 b8e6d595..449069c4 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.Attributes (toAttribute) +import OpenTelemetry.Attribute (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 80b632ee..c92cc0a0 100644 --- a/api/test/Spec.hs +++ b/api/test/Spec.hs @@ -8,9 +8,7 @@ import qualified Data.Bifunctor import Data.IORef import Data.Maybe (isJust) import qualified Data.Vector as V -import OpenTelemetry.Attributes (lookupAttribute) --- Specs - +import OpenTelemetry.Attribute import qualified OpenTelemetry.BaggageSpec as Baggage import OpenTelemetry.Context import OpenTelemetry.Trace.Core @@ -21,6 +19,8 @@ import Test.Hspec import qualified VectorBuilder.Vector as Builder +-- Specs + newtype TestException = TestException String deriving (Show) diff --git a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs index ebba7b01..afebfb5b 100644 --- a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs +++ b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs @@ -58,7 +58,6 @@ 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 @@ -68,7 +67,10 @@ import Network.HTTP.Client import Network.HTTP.Simple (httpBS) import Network.HTTP.Types.Header import Network.HTTP.Types.Status -import OpenTelemetry.Attributes +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 qualified OpenTelemetry.Baggage as Baggage import OpenTelemetry.Exporter import OpenTelemetry.Resource @@ -298,21 +300,20 @@ otlpExporter conf = do else pure Success -attributesToProto :: Attributes -> Vector KeyValue +attributesToProto :: AttributeCollection -> Vector KeyValue attributesToProto = V.fromList . fmap attributeToKeyValue - . H.toList - . snd - . getAttributes + . A.toList + . A.attributes where primAttributeToAnyValue = \case TextAttribute t -> defMessage & stringValue .~ t BoolAttribute b -> defMessage & boolValue .~ b DoubleAttribute d -> defMessage & doubleValue .~ d IntAttribute i -> defMessage & intValue .~ i - attributeToKeyValue :: (Text, Attribute) -> KeyValue - attributeToKeyValue (k, v) = + attributeToKeyValue :: (Key Attribute, Attribute) -> KeyValue + attributeToKeyValue (A.Key k, v) = defMessage & key .~ k & value @@ -394,7 +395,7 @@ makeSpan completedSpan = do & startTimeUnixNano .~ startTime & endTimeUnixNano .~ maybe startTime timestampNanoseconds (OT.spanEnd completedSpan) & vec'attributes .~ attributesToProto (OT.spanAttributes completedSpan) - & droppedAttributesCount .~ fromIntegral (fst (getAttributes $ OT.spanAttributes completedSpan)) + & droppedAttributesCount .~ fromIntegral (A.count $ 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) @@ -421,7 +422,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 (fst (getAttributes $ OT.eventAttributes e)) + & droppedAttributesCount .~ fromIntegral (A.count $ OT.eventAttributes e) makeLink :: OT.Link -> Span'Link @@ -430,4 +431,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 (fst (getAttributes $ OT.frozenLinkAttributes l)) + & droppedAttributesCount .~ fromIntegral (A.count $ OT.frozenLinkAttributes l) diff --git a/instrumentation/cloudflare/hs-opentelemetry-instrumentation-cloudflare.cabal b/instrumentation/cloudflare/hs-opentelemetry-instrumentation-cloudflare.cabal index 7e37506a..a6a045e4 100644 --- a/instrumentation/cloudflare/hs-opentelemetry-instrumentation-cloudflare.cabal +++ b/instrumentation/cloudflare/hs-opentelemetry-instrumentation-cloudflare.cabal @@ -37,7 +37,6 @@ library , hs-opentelemetry-instrumentation-wai , http-types , text - , unordered-containers , wai default-language: Haskell2010 @@ -57,6 +56,5 @@ 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 8dc823f3..3d49705a 100644 --- a/instrumentation/cloudflare/package.yaml +++ b/instrumentation/cloudflare/package.yaml @@ -26,7 +26,6 @@ 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 bdaee0f6..8c751c33 100644 --- a/instrumentation/cloudflare/src/OpenTelemetry/Instrumentation/Cloudflare.hs +++ b/instrumentation/cloudflare/src/OpenTelemetry/Instrumentation/Cloudflare.hs @@ -5,13 +5,14 @@ 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.Attributes (PrimitiveAttribute (..), ToAttribute (..)) +import OpenTelemetry.Attribute (IsAttribute (..), PrimitiveAttribute (..)) +import qualified OpenTelemetry.Attribute as A +import qualified OpenTelemetry.Attribute.Attributes as A import OpenTelemetry.Context import OpenTelemetry.Instrumentation.Wai (requestContext) import OpenTelemetry.Trace.Core (addAttributes) @@ -23,13 +24,13 @@ cloudflareInstrumentationMiddleware app req sendResp = do forM_ mCtxt $ \ctxt -> do forM_ (lookupSpan ctxt) $ \span_ -> do addAttributes span_ $ - H.unions $ + A.unions $ fmap ( \hn -> case Data.List.lookup hn $ requestHeaders req of Nothing -> [] Just val -> [ - ( "http.request.header." <> T.decodeUtf8 (CI.foldedCase hn) + ( A.Key $ "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 bb169e01..2c9184d0 100644 --- a/instrumentation/hedis/hs-opentelemetry-instrumentation-hedis.cabal +++ b/instrumentation/hedis/hs-opentelemetry-instrumentation-hedis.cabal @@ -34,8 +34,7 @@ library mtl, safe-exceptions, text, - unliftio-core, - unordered-containers + unliftio-core 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 d66c4cc0..6680fc2d 100644 --- a/instrumentation/hedis/src/OpenTelemetry/Instrumentation/Hedis.hs +++ b/instrumentation/hedis/src/OpenTelemetry/Instrumentation/Hedis.hs @@ -363,7 +363,6 @@ 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) @@ -371,7 +370,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, SpanArguments (attributes, kind), SpanKind (Client), Tracer, TracerProvider, defaultSpanArguments, getGlobalTracerProvider, inSpan, makeTracer, tracerOptions) +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.Monad as Otel (MonadTracer, TracerT (TracerT)) import Text.Read (readMaybe) @@ -554,11 +553,11 @@ inSpan tracer name info f = do Otel.inSpan tracer name args f -makeAttributes :: Orig.ConnectInfo -> H.HashMap Text Otel.Attribute +makeAttributes :: Orig.ConnectInfo -> Otel.Attributes makeAttributes info@Orig.ConnInfo {Orig.connectHost, Orig.connectPort} = let transportAttr :: Otel.Attribute - portAttr :: (Text, Otel.Attribute) + portAttr :: (Otel.Key Otel.Attribute, 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 33c243a5..fc087486 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,7 +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.Attributes as Otel +import qualified OpenTelemetry.Attribute.AttributeCollection as OtelAttr +import qualified OpenTelemetry.Attribute.Attributes as OtelAttr import qualified OpenTelemetry.Context as Otel import qualified OpenTelemetry.Context.ThreadLocal as Otel import qualified OpenTelemetry.Resource as Otel @@ -206,15 +207,15 @@ datadogPayload tracerProvider maybeSpan = do ) let attributes = Otel.getMaterializedResourcesAttributes $ Otel.getTracerProviderResources tracerProvider - maybeEnv = attributeAsText =<< Otel.lookupAttribute attributes Datadog.envKey + maybeEnv :: Maybe Text + maybeEnv = OtelAttr.lookup Datadog.envKey $ OtelAttr.attributes attributes maybeService = - attributeAsText - =<< ( Otel.lookupAttribute attributes Datadog.serviceKey - <|> - -- "service.name" is the same key in the OpenTelemetry.Resource.Service module - Otel.lookupAttribute attributes "service.name" - ) - maybeVersion = attributeAsText =<< Otel.lookupAttribute attributes Datadog.versionKey + ( OtelAttr.lookup Datadog.serviceKey (OtelAttr.attributes attributes) + <|> + -- "service.name" is the same key in the OpenTelemetry.Resource.Service module + OtelAttr.lookup "service.name" (OtelAttr.attributes attributes) + ) + maybeVersion = OtelAttr.lookup Datadog.versionKey (OtelAttr.attributes attributes) pure $ (\payloadObject -> mempty {Orig.payloadObject}) $ Aeson.fromList $ @@ -226,8 +227,3 @@ datadogPayload tracerProvider maybeSpan = do , ("dd.service",) . Aeson.String <$> maybeService , ("dd.version",) . Aeson.String <$> maybeVersion ] - - -attributeAsText :: Otel.Attribute -> Maybe Text -attributeAsText (Otel.AttributeValue (Otel.TextAttribute a)) = Just a -attributeAsText _ = Nothing diff --git a/instrumentation/hspec/src/OpenTelemetry/Instrumentation/Hspec.hs b/instrumentation/hspec/src/OpenTelemetry/Instrumentation/Hspec.hs index 53a31496..e0bb4e69 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.Attributes (Attributes) +import OpenTelemetry.Attribute (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 dfc9d86c..9313933a 100644 --- a/instrumentation/http-client/src/OpenTelemetry/Instrumentation/HttpClient/Raw.hs +++ b/instrumentation/http-client/src/OpenTelemetry/Instrumentation/HttpClient/Raw.hs @@ -8,13 +8,14 @@ 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 @@ -93,9 +94,9 @@ instrumentRequest tracer conf ctxt req = do ) ] addAttributes s - $ H.fromList + $ A.fromList $ mapMaybe - (\h -> (\v -> ("http.request.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (requestHeaders req)) + (\h -> (\v -> (A.Key $ "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 @@ -132,7 +133,7 @@ instrumentResponse tracer conf ctxt resp = do -- , ("net.peer.port") ] addAttributes s - $ H.fromList + $ A.fromList $ mapMaybe - (\h -> (\v -> ("http.response.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (responseHeaders resp)) + (\h -> (\v -> (A.Key $ "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 033688bf..55b85482 100644 --- a/instrumentation/persistent-mysql/hs-opentelemetry-instrumentation-persistent-mysql.cabal +++ b/instrumentation/persistent-mysql/hs-opentelemetry-instrumentation-persistent-mysql.cabal @@ -24,9 +24,7 @@ library persistent, persistent-mysql, resource-pool, - text, - unliftio-core, - unordered-containers + unliftio-core 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 2deb660e..7a7223ba 100644 --- a/instrumentation/persistent-mysql/src/OpenTelemetry/Instrumentation/Persistent/MySQL.hs +++ b/instrumentation/persistent-mysql/src/OpenTelemetry/Instrumentation/Persistent/MySQL.hs @@ -32,17 +32,16 @@ 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) @@ -56,7 +55,7 @@ createMySQLPool :: (MonadUnliftIO m, MonadLoggerIO m) => Otel.TracerProvider -> -- | Additional attributes. - H.HashMap Text Otel.Attribute -> + Otel.Attributes -> -- | Connection information. MySQL.ConnectInfo -> -- | Number of connections to be kept open in the pool. @@ -74,7 +73,7 @@ withMySQLPool :: (MonadLoggerIO m, MonadUnliftIO m) => Otel.TracerProvider -> -- | Additional attributes. - H.HashMap Text Otel.Attribute -> + Otel.Attributes -> -- | Connection information. MySQL.ConnectInfo -> -- | Number of connections to be kept open in the pool. @@ -93,7 +92,7 @@ About attributes, see https://opentelemetry.io/docs/reference/specification/trac openMySQLConn :: Otel.TracerProvider -> -- | Additional attributes. - H.HashMap Text Otel.Attribute -> + Otel.Attributes -> -- | Connection information. MySQL.ConnectInfo -> LogFunc -> @@ -116,7 +115,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' = - H.union + OtelAttr.union [ ("db.connection_string", fromString $ showsPrecConnectInfoMasked 0 ci "") , ("db.user", fromString connectUser) , ("net.peer.port", portAttr) @@ -137,7 +136,7 @@ withMySQLConn :: (MonadUnliftIO m, MonadLoggerIO m) => Otel.TracerProvider -> -- | Additional attributes. - H.HashMap Text Otel.Attribute -> + Otel.Attributes -> -- | 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 1f49a65e..d78021ce 100644 --- a/instrumentation/persistent/src/OpenTelemetry/Instrumentation/Persistent.hs +++ b/instrumentation/persistent/src/OpenTelemetry/Instrumentation/Persistent.hs @@ -20,7 +20,8 @@ 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.Attributes (Attributes) +import OpenTelemetry.Attribute (Attributes) +import qualified OpenTelemetry.Attribute.Attributes as A import OpenTelemetry.Context import OpenTelemetry.Context.ThreadLocal (adjustContext, getContext) import OpenTelemetry.Resource @@ -55,7 +56,7 @@ lookupOriginalConnection :: SqlBackend -> Maybe SqlBackend lookupOriginalConnection = Vault.lookup originalConnectionKey . getConnVault -connectionLevelAttributesKey :: Vault.Key (H.HashMap Text Attribute) +connectionLevelAttributesKey :: Vault.Key (Attributes) connectionLevelAttributesKey = unsafePerformIO Vault.newKey {-# NOINLINE connectionLevelAttributesKey #-} @@ -66,7 +67,7 @@ connectionLevelAttributesKey = unsafePerformIO Vault.newKey wrapSqlBackend :: (MonadIO m) => -- | Attributes that are specific to providers like MySQL, PostgreSQL, etc. - H.HashMap Text Attribute -> + Attributes -> SqlBackend -> m SqlBackend wrapSqlBackend attrs conn_ = do @@ -80,7 +81,7 @@ so that queries are tracked appropriately in the tracing hierarchy. wrapSqlBackend' :: TracerProvider -> -- | Attributes that are specific to providers like MySQL, PostgreSQL, etc. - H.HashMap Text Attribute -> + Attributes -> SqlBackend -> SqlBackend wrapSqlBackend' tp attrs conn_ = @@ -100,7 +101,7 @@ wrapSqlBackend' tp attrs conn_ = t ctxt sql - (defaultSpanArguments {kind = Client, attributes = H.insert "db.statement" (toAttribute sql) attrs}) + (defaultSpanArguments {kind = Client, attributes = A.insert "db.statement" (toAttribute sql) attrs}) adjustContext (insertSpan s) pure (lookupSpan ctxt, s) spanCleanup (parent, s) = do @@ -121,7 +122,7 @@ wrapSqlBackend' tp attrs conn_ = ) (stmtQueryAcquireF f) , stmtExecute = withFrozenCallStack $ \ps -> do - inSpan' t sql (defaultSpanArguments {kind = Client, attributes = H.insert "db.statement" (toAttribute sql) attrs}) $ \s -> do + inSpan' t sql (defaultSpanArguments {kind = Client, attributes = A.insert "db.statement" (toAttribute sql) attrs}) $ \s -> do annotateBasics s conn stmtExecute stmt ps , stmtReset = stmtReset stmt @@ -140,16 +141,16 @@ wrapSqlBackend' tp attrs conn_ = Just ReadCommitted -> " isolation level read committed" Just RepeatableRead -> " isolation level repeatable read" Just Serializable -> " isolation level serializable" - let attrs' = H.insert "db.statement" (toAttribute statement) attrs + let attrs' = A.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 = H.insert "db.statement" (toAttribute ("commit" :: Text)) attrs}) $ \s -> do + inSpan' t "commit" (defaultSpanArguments {kind = Client, attributes = A.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 = H.insert "db.statement" (toAttribute ("rollback" :: Text)) attrs}) $ \s -> do + inSpan' t "rollback" (defaultSpanArguments {kind = Client, attributes = A.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 143db867..13b533a7 100644 --- a/instrumentation/postgresql-simple/src/OpenTelemetry/Instrumentation/PostgresqlSimple.hs +++ b/instrumentation/postgresql-simple/src/OpenTelemetry/Instrumentation/PostgresqlSimple.hs @@ -74,6 +74,7 @@ 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 @@ -82,7 +83,7 @@ import UnliftIO -- | Get attributes that can be attached to a span denoting some database action -staticConnectionAttributes :: MonadIO m => Connection -> m (H.HashMap T.Text Attribute) +staticConnectionAttributes :: MonadIO m => Connection -> m Attributes staticConnectionAttributes Connection {connectionHandle} = liftIO $ do (mDb, mUser, mHost, mPort) <- withMVar connectionHandle $ \pqConn -> do (,,,) @@ -91,7 +92,7 @@ staticConnectionAttributes Connection {connectionHandle} = liftIO $ do <*> LibPQ.host pqConn <*> LibPQ.port pqConn pure $ - H.fromList $ + A.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 1f2f390a..e55e5a39 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.Attributes (lookupAttribute) +import OpenTelemetry.Attribute (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 28df383e..52a3ef4d 100644 --- a/instrumentation/yesod/hs-opentelemetry-instrumentation-yesod.cabal +++ b/instrumentation/yesod/hs-opentelemetry-instrumentation-yesod.cabal @@ -43,7 +43,6 @@ library , template-haskell , text , unliftio - , unordered-containers , vault , wai , yesod-core @@ -68,7 +67,6 @@ 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 5f5caad9..2871d1b0 100644 --- a/instrumentation/yesod/package.yaml +++ b/instrumentation/yesod/package.yaml @@ -31,7 +31,6 @@ 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 3d77e75f..7069dac5 100644 --- a/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs +++ b/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs @@ -30,7 +30,6 @@ module OpenTelemetry.Instrumentation.Yesod ( ) where 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 @@ -39,7 +38,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Vault.Lazy as V -import GHC.Stack (HasCallStack) +import GHC.Stack (HasCallStack, withFrozenCallStack) import Language.Haskell.TH ( Clause, Dec, @@ -60,24 +59,16 @@ import Language.Haskell.TH ( varP, wildP, ) - - -#if MIN_VERSION_template_haskell(2, 17, 0) -import Language.Haskell.TH (Quote (newName)) -#else -import Language.Haskell.TH (newName) -#endif -import qualified Data.HashMap.Strict as H -import GHC.Stack (withFrozenCallStack) 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, @@ -122,6 +113,13 @@ 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 #-} @@ -332,7 +330,7 @@ openTelemetryYesodMiddleware rr (HandlerFor doResponse) = mspan <- Context.lookupSpan <$> getContext mr <- getCurrentRoute let sharedAttributes = - H.fromList $ + A.fromList $ catMaybes [ do r <- mr diff --git a/sdk/hs-opentelemetry-sdk.cabal b/sdk/hs-opentelemetry-sdk.cabal index ec199ecb..4d49dd18 100644 --- a/sdk/hs-opentelemetry-sdk.cabal +++ b/sdk/hs-opentelemetry-sdk.cabal @@ -41,7 +41,11 @@ library other-modules: Paths_hs_opentelemetry_sdk reexported-modules: - OpenTelemetry.Attributes + OpenTelemetry.Attribute + , OpenTelemetry.Attribute.Attribute + , OpenTelemetry.Attribute.Attributes + , OpenTelemetry.Attribute.AttributeCollection + , OpenTelemetry.Attribute.Key , OpenTelemetry.Baggage , OpenTelemetry.Context , OpenTelemetry.Context.ThreadLocal diff --git a/sdk/package.yaml b/sdk/package.yaml index 19288be9..8db5b14c 100644 --- a/sdk/package.yaml +++ b/sdk/package.yaml @@ -49,7 +49,11 @@ library: ghc-options: -Wall source-dirs: src reexported-modules: - - OpenTelemetry.Attributes + - OpenTelemetry.Attribute + - OpenTelemetry.Attribute.Attribute + - OpenTelemetry.Attribute.Attributes + - OpenTelemetry.Attribute.AttributeCollection + - OpenTelemetry.Attribute.Key - OpenTelemetry.Baggage - OpenTelemetry.Context - OpenTelemetry.Context.ThreadLocal diff --git a/sdk/src/OpenTelemetry/Trace.hs b/sdk/src/OpenTelemetry/Trace.hs index f19e1665..ead396e6 100644 --- a/sdk/src/OpenTelemetry/Trace.hs +++ b/sdk/src/OpenTelemetry/Trace.hs @@ -150,8 +150,8 @@ module OpenTelemetry.Trace ( createSpanWithoutCallStack, endSpan, spanGetAttributes, - ToAttribute (..), - ToPrimitiveAttribute (..), + IsAttribute (..), + IsPrimitiveAttribute (..), Attribute (..), PrimitiveAttribute (..), Link, @@ -168,7 +168,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import Network.HTTP.Types.Header -import OpenTelemetry.Attributes (AttributeLimits (..), defaultAttributeLimits) +import OpenTelemetry.Attribute (AttributeLimits (..), defaultAttributeLimits) import OpenTelemetry.Baggage (decodeBaggageHeader) import qualified OpenTelemetry.Baggage as Baggage import OpenTelemetry.Context (Context) @@ -483,7 +483,7 @@ detectExporters = do -- -- detectMetricsExporterSelection :: _ -- -- TODO other metrics stuff -detectResourceAttributes :: IO [(T.Text, Attribute)] +detectResourceAttributes :: IO [(Key Attribute, Attribute)] detectResourceAttributes = do mEnv <- lookupEnv "OTEL_RESOURCE_ATTRIBUTES" case mEnv of @@ -495,7 +495,7 @@ detectResourceAttributes = do pure [] Right ok -> pure $ - map (\(k, v) -> (decodeUtf8 $ Baggage.tokenValue k, toAttribute $ Baggage.value v)) $ + map (\(k, v) -> (Key $ 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 44e79e16..20d5031e 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 (ToAttribute (..), endSpan, recordException, setStatus, whenSpanIsRecording) +import OpenTelemetry.Trace.Core (IsAttribute (..), endSpan, recordException, setStatus, whenSpanIsRecording) import qualified OpenTelemetry.Trace.Core as TraceCore diff --git a/vendors/datadog/hs-opentelemetry-vendor-datadog.cabal b/vendors/datadog/hs-opentelemetry-vendor-datadog.cabal index 56d298ef..fb6d4d8d 100644 --- a/vendors/datadog/hs-opentelemetry-vendor-datadog.cabal +++ b/vendors/datadog/hs-opentelemetry-vendor-datadog.cabal @@ -56,7 +56,6 @@ test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test/spec - old-src other-modules: OpenTelemetry.Vendor.DatadogSpec build-depends: hs-opentelemetry-vendor-datadog, hs-opentelemetry-api, diff --git a/vendors/datadog/src/OpenTelemetry/Vendor/Datadog.hs b/vendors/datadog/src/OpenTelemetry/Vendor/Datadog.hs index 8bbe0fdc..ca3c51cb 100644 --- a/vendors/datadog/src/OpenTelemetry/Vendor/Datadog.hs +++ b/vendors/datadog/src/OpenTelemetry/Vendor/Datadog.hs @@ -45,6 +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.Internal.Trace.Id as Trace import OpenTelemetry.Resource (Resource, mkResource) import OpenTelemetry.Vendor.Datadog.Internal (indexByteArrayNbo) @@ -59,15 +60,15 @@ convertOpenTelemetryTraceIdToDatadogTraceId :: Trace.TraceId -> Word64 convertOpenTelemetryTraceIdToDatadogTraceId (Trace.TraceId (SBI.SBS a)) = indexByteArrayNbo (ByteArray a) 1 -envKey :: Text +envKey :: Attribute.Key Text envKey = "dd.env" -serviceKey :: Text +serviceKey :: Attribute.Key Text serviceKey = "dd.service" -versionKey :: Text +versionKey :: Attribute.Key Text versionKey = "dd.version" @@ -82,4 +83,4 @@ detectResource = do env <- (envKey,) <$> lookupEnv "DD_ENV" service <- (serviceKey,) <$> lookupEnv "DD_SERVICE" version <- (versionKey,) <$> lookupEnv "DD_VERSION" - pure $ mkResource $ (\(k, mv) -> (k,) . fromString <$> mv) <$> [env, service, version] + pure $ mkResource $ (\(Attribute.Key k, mv) -> (Attribute.Key k,) . fromString <$> mv) <$> [env, service, version] From 47310b5e29cd2243d3d5e39af35cb43a87d22d84 Mon Sep 17 00:00:00 2001 From: Kazuki Okamoto Date: Wed, 10 Jan 2024 22:32:56 +0900 Subject: [PATCH 2/2] =?UTF-8?q?HashMap=20Text=20Attribute=20=E3=81=AE=20ne?= =?UTF-8?q?wtype=20=E3=82=92=E3=81=A4=E3=81=8F=E3=82=8B=E3=81=AE=E3=82=92?= =?UTF-8?q?=E3=82=84=E3=82=81=E3=82=8B?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit IsAttribute を ToAttribute と FromAttribute に分ける モジュール名変える --- api/hs-opentelemetry-api.cabal | 9 +- api/src/OpenTelemetry/Attribute.hs | 27 --- .../Attribute/AttributeCollection.hs | 169 ---------------- api/src/OpenTelemetry/Attribute/Attributes.hs | 115 ----------- api/src/OpenTelemetry/Attributes.hs | 186 ++++++++++++++++++ .../{Attribute => Attributes}/Attribute.hs | 100 +++++++--- .../{Attribute => Attributes}/Key.hs | 6 +- api/src/OpenTelemetry/Attributes/Map.hs | 59 ++++++ api/src/OpenTelemetry/Internal/Trace/Types.hs | 18 +- api/src/OpenTelemetry/Logging/Core.hs | 2 +- api/src/OpenTelemetry/Resource.hs | 19 +- api/src/OpenTelemetry/Trace/Core.hs | 50 +++-- api/src/OpenTelemetry/Trace/Sampler.hs | 2 +- api/test/Spec.hs | 2 +- .../otlp/src/OpenTelemetry/Exporter/OTLP.hs | 22 +-- ...telemetry-instrumentation-cloudflare.cabal | 2 + instrumentation/cloudflare/package.yaml | 1 + .../Instrumentation/Cloudflare.hs | 9 +- ...-opentelemetry-instrumentation-hedis.cabal | 3 +- .../OpenTelemetry/Instrumentation/Hedis.hs | 7 +- .../Instrumentation/Herp/Logger/Datadog.hs | 12 +- .../OpenTelemetry/Instrumentation/Hspec.hs | 2 +- .../Instrumentation/HttpClient/Raw.hs | 11 +- ...try-instrumentation-persistent-mysql.cabal | 4 +- .../Instrumentation/Persistent/MySQL.hs | 13 +- .../Instrumentation/Persistent.hs | 19 +- .../Instrumentation/PostgresqlSimple.hs | 5 +- .../src/OpenTelemetry/Instrumentation/Wai.hs | 2 +- ...-opentelemetry-instrumentation-yesod.cabal | 2 + instrumentation/yesod/package.yaml | 1 + .../OpenTelemetry/Instrumentation/Yesod.hs | 6 +- sdk/hs-opentelemetry-sdk.cabal | 9 +- sdk/package.yaml | 9 +- sdk/src/OpenTelemetry/Trace.hs | 12 +- .../src/OpenTelemetry/Utils/Exceptions.hs | 2 +- .../src/OpenTelemetry/Vendor/Datadog.hs | 6 +- 36 files changed, 462 insertions(+), 461 deletions(-) delete mode 100644 api/src/OpenTelemetry/Attribute.hs delete mode 100644 api/src/OpenTelemetry/Attribute/AttributeCollection.hs delete mode 100644 api/src/OpenTelemetry/Attribute/Attributes.hs create mode 100644 api/src/OpenTelemetry/Attributes.hs rename api/src/OpenTelemetry/{Attribute => Attributes}/Attribute.hs (67%) rename api/src/OpenTelemetry/{Attribute => Attributes}/Key.hs (99%) create mode 100644 api/src/OpenTelemetry/Attributes/Map.hs 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..2a77215f --- /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 dropped. + , 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..fbdbe47f --- /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 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..dc070dcb 100644 --- a/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs +++ b/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs @@ -30,6 +30,7 @@ module OpenTelemetry.Instrumentation.Yesod ( ) where 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 +62,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, @@ -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]