diff --git a/api/hs-opentelemetry-api.cabal b/api/hs-opentelemetry-api.cabal index ce3f966b..7ebd3bd7 100644 --- a/api/hs-opentelemetry-api.cabal +++ b/api/hs-opentelemetry-api.cabal @@ -28,6 +28,9 @@ source-repository head library exposed-modules: OpenTelemetry.Attributes + OpenTelemetry.Attributes.Attribute + OpenTelemetry.Attributes.Key + OpenTelemetry.Attributes.Map OpenTelemetry.Baggage OpenTelemetry.Common OpenTelemetry.Context diff --git a/api/src/OpenTelemetry/Attributes.hs b/api/src/OpenTelemetry/Attributes.hs index dc41a094..2a77215f 100644 --- a/api/src/OpenTelemetry/Attributes.hs +++ b/api/src/OpenTelemetry/Attributes.hs @@ -18,23 +18,34 @@ 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 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. + + - 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, - getAttributes, lookupAttribute, + lookupAttributeByKey, + getAttributes, + getCount, Attribute (..), ToAttribute (..), + FromAttribute (..), PrimitiveAttribute (..), ToPrimitiveAttribute (..), + FromPrimitiveAttribute (..), + Key (..), + module Key, -- * Attribute limits AttributeLimits (..), @@ -49,11 +60,13 @@ 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) +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. @@ -61,7 +74,7 @@ import GHC.Generics (Generic) Values: - 'attributeCountLimit': @Just 128@ - - 'attributeLengthLimit': or @Nothing@ + - 'attributeLengthLimit': Infinity or @Nothing@ -} defaultAttributeLimits :: AttributeLimits defaultAttributeLimits = @@ -79,6 +92,10 @@ data Attributes = Attributes deriving stock (Show, Eq) +instance Default Attributes where + def = emptyAttributes + + emptyAttributes :: Attributes emptyAttributes = Attributes mempty 0 0 @@ -96,7 +113,11 @@ addAttribute AttributeLimits {..} Attributes {..} !k !v = case attributeCountLim {-# INLINE addAttribute #-} -addAttributes :: ToAttribute a => AttributeLimits -> Attributes -> H.HashMap Text a -> Attributes +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_ -> @@ -104,7 +125,7 @@ addAttributes AttributeLimits {..} Attributes {..} attrs = case attributeCountLi then Attributes attributes attributesCount (attributesDropped + H.size attrs) else Attributes newAttrs newCount attributesDropped where - newAttrs = H.union attributes $ H.map toAttribute attrs + newAttrs = H.union attributes attrs newCount = H.size newAttrs {-# INLINE addAttributes #-} @@ -119,14 +140,22 @@ limitLengths limit (AttributeValue val) = AttributeValue $ limitPrimAttr limit v limitLengths limit (AttributeArray arr) = AttributeArray $ fmap (limitPrimAttr limit) arr -getAttributes :: Attributes -> (Int, H.HashMap Text Attribute) -getAttributes Attributes {..} = (attributesCount, attributes) +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. @@ -146,123 +175,6 @@ 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) diff --git a/api/src/OpenTelemetry/Attributes/Attribute.hs b/api/src/OpenTelemetry/Attributes/Attribute.hs new file mode 100644 index 00000000..f2a87123 --- /dev/null +++ b/api/src/OpenTelemetry/Attributes/Attribute.hs @@ -0,0 +1,224 @@ +{-# 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.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.Attributes.Attribute ( + Attribute (..), + ToAttribute (..), + FromAttribute (..), + PrimitiveAttribute (..), + ToPrimitiveAttribute (..), + FromPrimitiveAttribute (..), +) 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 ToPrimitiveAttribute a where + toPrimitiveAttribute :: a -> PrimitiveAttribute + + +class FromPrimitiveAttribute a where + 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 'ToAttribute' and use the default 'toAttribute' implementation: + + @ + + data Foo = Foo + + instance ToAttribute 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 + + +class FromAttribute a where + fromAttribute :: Attribute -> Maybe a + default fromAttribute :: (FromPrimitiveAttribute a) => Attribute -> Maybe a + fromAttribute (AttributeValue v) = fromPrimitiveAttribute v + fromAttribute _ = Nothing + + +instance ToPrimitiveAttribute PrimitiveAttribute where + toPrimitiveAttribute = id + + +instance FromPrimitiveAttribute PrimitiveAttribute where + fromPrimitiveAttribute = Just + + +instance ToAttribute PrimitiveAttribute where + toAttribute = AttributeValue + + +instance FromAttribute PrimitiveAttribute where + fromAttribute (AttributeValue v) = Just v + fromAttribute _ = Nothing + + +instance ToPrimitiveAttribute Text where + toPrimitiveAttribute = TextAttribute + + +instance FromPrimitiveAttribute Text where + fromPrimitiveAttribute (TextAttribute v) = Just v + fromPrimitiveAttribute _ = Nothing + + +instance ToAttribute Text + + +instance FromAttribute Text + + +instance ToPrimitiveAttribute Bool where + toPrimitiveAttribute = BoolAttribute + + +instance FromPrimitiveAttribute Bool where + fromPrimitiveAttribute (BoolAttribute v) = Just v + fromPrimitiveAttribute _ = Nothing + + +instance ToAttribute Bool + + +instance FromAttribute Bool + + +instance ToPrimitiveAttribute Double where + toPrimitiveAttribute = DoubleAttribute + + +instance FromPrimitiveAttribute Double where + fromPrimitiveAttribute (DoubleAttribute v) = Just v + fromPrimitiveAttribute _ = Nothing + + +instance ToAttribute Double + + +instance FromAttribute Double + + +instance ToPrimitiveAttribute Int64 where + toPrimitiveAttribute = IntAttribute + + +instance FromPrimitiveAttribute Int64 where + fromPrimitiveAttribute (IntAttribute v) = Just v + fromPrimitiveAttribute _ = Nothing + + +instance ToAttribute Int64 + + +instance FromAttribute Int64 + + +instance ToPrimitiveAttribute Int where + toPrimitiveAttribute = IntAttribute . fromIntegral + + +instance FromPrimitiveAttribute Int where + fromPrimitiveAttribute (IntAttribute v) = Just $ fromIntegral v + fromPrimitiveAttribute _ = Nothing + + +instance ToAttribute Int + + +instance FromAttribute Int + + +instance ToAttribute Attribute where + toAttribute = id + + +instance FromAttribute Attribute where + fromAttribute = Just + + +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/Attributes/Key.hs b/api/src/OpenTelemetry/Attributes/Key.hs new file mode 100644 index 00000000..34e3cf04 --- /dev/null +++ b/api/src/OpenTelemetry/Attributes/Key.hs @@ -0,0 +1,904 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} + +{- | +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 +Maintainer : Kazuki Okamoto (岡本和樹) +Stability : experimental +Portability : non-portable (GHC extensions) +-} +module OpenTelemetry.Attributes.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.Attributes.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/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/Trace/Core.hs b/api/src/OpenTelemetry/Trace/Core.hs index 69884d54..3d01ad16 100644 --- a/api/src/OpenTelemetry/Trace/Core.hs +++ b/api/src/OpenTelemetry/Trace/Core.hs @@ -105,12 +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.ToAttribute (..), + A.FromAttribute (..), A.PrimitiveAttribute (..), A.ToPrimitiveAttribute (..), + A.FromPrimitiveAttribute (..), + A.Key, + A.Attributes, -- ** Recording error information recordException, @@ -435,6 +440,18 @@ 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'. diff --git a/api/test/Spec.hs b/api/test/Spec.hs index 80b632ee..7c3253a5 100644 --- a/api/test/Spec.hs +++ b/api/test/Spec.hs @@ -9,8 +9,6 @@ import Data.IORef import Data.Maybe (isJust) import qualified Data.Vector as V import OpenTelemetry.Attributes (lookupAttribute) --- Specs - 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..617a0048 100644 --- a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs +++ b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs @@ -303,7 +303,6 @@ attributesToProto = V.fromList . fmap attributeToKeyValue . H.toList - . snd . getAttributes where primAttributeToAnyValue = \case @@ -394,7 +393,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 (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) @@ -421,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 (fst (getAttributes $ OT.eventAttributes e)) + & droppedAttributesCount .~ fromIntegral (getCount $ OT.eventAttributes e) makeLink :: OT.Link -> Span'Link @@ -430,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 (fst (getAttributes $ OT.frozenLinkAttributes l)) + & droppedAttributesCount .~ fromIntegral (getCount $ OT.frozenLinkAttributes l) 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..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 @@ -69,6 +69,7 @@ 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.Attributes.Map as Otel 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 = Otel.lookupByKey Datadog.envKey $ Otel.getAttributes 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 + ( Otel.lookupByKey Datadog.serviceKey (Otel.getAttributes attributes) + <|> + -- "service.name" is the same key in the OpenTelemetry.Resource.Service module + Otel.lookupByKey Otel.peer_service (Otel.getAttributes attributes) + ) + maybeVersion = Otel.lookupByKey Datadog.versionKey (Otel.getAttributes 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/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs b/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs index 3d77e75f..dc070dcb 100644 --- a/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs +++ b/instrumentation/yesod/src/OpenTelemetry/Instrumentation/Yesod.hs @@ -39,7 +39,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,15 +60,6 @@ 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.Context as Context @@ -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 #-} diff --git a/sdk/hs-opentelemetry-sdk.cabal b/sdk/hs-opentelemetry-sdk.cabal index ec199ecb..d6cf7282 100644 --- a/sdk/hs-opentelemetry-sdk.cabal +++ b/sdk/hs-opentelemetry-sdk.cabal @@ -42,6 +42,9 @@ library Paths_hs_opentelemetry_sdk reexported-modules: 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 19288be9..16804d94 100644 --- a/sdk/package.yaml +++ b/sdk/package.yaml @@ -50,6 +50,9 @@ library: source-dirs: src reexported-modules: - 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 f19e1665..73c91f65 100644 --- a/sdk/src/OpenTelemetry/Trace.hs +++ b/sdk/src/OpenTelemetry/Trace.hs @@ -151,7 +151,9 @@ module OpenTelemetry.Trace ( endSpan, spanGetAttributes, ToAttribute (..), + FromAttribute (..), ToPrimitiveAttribute (..), + FromPrimitiveAttribute (..), Attribute (..), PrimitiveAttribute (..), Link, 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..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,6 +45,7 @@ import Data.Primitive (ByteArray (ByteArray)) import Data.String (fromString) import Data.Text (Text) import Data.Word (Word64) +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) @@ -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) -> (k,) . fromString <$> mv) <$> [env, service, version]