-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The environment reads and the projections behind "Ecluse.Runtime.Telemetry.Resolve", which
documents the configuration model and re-exports the curated surface. Importing this module opts
out of that stability promise, the convention @text@ and @bytestring@ use, so production code
imports the public one.
-}
module Ecluse.Runtime.Telemetry.Resolve.Internal (
    -- * The resolved telemetry identity
    ResolvedTelemetry (..),
    TelemetryEndpoint (..),
    EndpointSource (..),
    resolveTelemetry,
    declaredEnv,

    -- * Canonical @OTEL_*@ projection
    otelEnvironmentOverrides,
    ResourceAttributes (..),
    resourceAttributes,

    -- * Boot wiring
    telemetryWarnings,
    prepareTelemetry,
) where

import Data.ByteString qualified as BS
import Data.List (lookup)
import Data.Text qualified as T
import GHC.Exts qualified as Exts
import System.Environment (setEnv)

import Katip (LogEnv, Severity (WarningS))
import OpenTelemetry.Baggage (Baggage, Element, Token)
import OpenTelemetry.Baggage qualified as Baggage

import Ecluse.Core.BuildIdentity (productVersion)
import Ecluse.Core.Text (nonBlank)
import Ecluse.Runtime.Log (moduleLog)

{- | Where a resolved OTLP endpoint came from, so the boot path can tell a configured target from
the silent default.
-}
data EndpointSource
    = -- | Derived from @DD_AGENT_HOST@ (as @http:\/\/{host}:4318@).
      FromDdAgentHost
    | -- | Taken verbatim from @OTEL_EXPORTER_OTLP_ENDPOINT@.
      FromOtelEndpoint
    | -- | No endpoint was configured, so the @http:\/\/localhost:4318@ default applies.
      DefaultedEndpoint
    deriving stock (EndpointSource -> EndpointSource -> Bool
(EndpointSource -> EndpointSource -> Bool)
-> (EndpointSource -> EndpointSource -> Bool) -> Eq EndpointSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndpointSource -> EndpointSource -> Bool
== :: EndpointSource -> EndpointSource -> Bool
$c/= :: EndpointSource -> EndpointSource -> Bool
/= :: EndpointSource -> EndpointSource -> Bool
Eq, Int -> EndpointSource -> ShowS
[EndpointSource] -> ShowS
EndpointSource -> String
(Int -> EndpointSource -> ShowS)
-> (EndpointSource -> String)
-> ([EndpointSource] -> ShowS)
-> Show EndpointSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EndpointSource -> ShowS
showsPrec :: Int -> EndpointSource -> ShowS
$cshow :: EndpointSource -> String
show :: EndpointSource -> String
$cshowList :: [EndpointSource] -> ShowS
showList :: [EndpointSource] -> ShowS
Show)

-- | A resolved OTLP export endpoint and the source it was resolved from.
data TelemetryEndpoint = TelemetryEndpoint
    { TelemetryEndpoint -> Text
teUrl :: Text
    -- ^ The endpoint URL the exporter targets (always @http\/protobuf@).
    , TelemetryEndpoint -> EndpointSource
teSource :: EndpointSource
    -- ^ How the URL was resolved.
    }
    deriving stock (TelemetryEndpoint -> TelemetryEndpoint -> Bool
(TelemetryEndpoint -> TelemetryEndpoint -> Bool)
-> (TelemetryEndpoint -> TelemetryEndpoint -> Bool)
-> Eq TelemetryEndpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TelemetryEndpoint -> TelemetryEndpoint -> Bool
== :: TelemetryEndpoint -> TelemetryEndpoint -> Bool
$c/= :: TelemetryEndpoint -> TelemetryEndpoint -> Bool
/= :: TelemetryEndpoint -> TelemetryEndpoint -> Bool
Eq, Int -> TelemetryEndpoint -> ShowS
[TelemetryEndpoint] -> ShowS
TelemetryEndpoint -> String
(Int -> TelemetryEndpoint -> ShowS)
-> (TelemetryEndpoint -> String)
-> ([TelemetryEndpoint] -> ShowS)
-> Show TelemetryEndpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TelemetryEndpoint -> ShowS
showsPrec :: Int -> TelemetryEndpoint -> ShowS
$cshow :: TelemetryEndpoint -> String
show :: TelemetryEndpoint -> String
$cshowList :: [TelemetryEndpoint] -> ShowS
showList :: [TelemetryEndpoint] -> ShowS
Show)

{- | The telemetry identity the SDK configuration and the @dd@ log object share. The process
cannot know its own deployment environment, so 'rtEnvironment' stays optional.
-}
data ResolvedTelemetry = ResolvedTelemetry
    { ResolvedTelemetry -> Text
rtServiceName :: Text
    -- ^ @service.name@ \/ @dd.service@ (defaults to @ecluse@).
    , ResolvedTelemetry -> Maybe Text
rtEnvironment :: Maybe Text
    -- ^ @deployment.environment.name@ \/ @dd.env@, when configured.
    , ResolvedTelemetry -> Maybe Text
rtVersion :: Maybe Text
    -- ^ @service.version@ \/ @dd.version@ (defaults to the build version).
    , ResolvedTelemetry -> TelemetryEndpoint
rtEndpoint :: TelemetryEndpoint
    -- ^ The resolved OTLP export endpoint.
    }
    deriving stock (ResolvedTelemetry -> ResolvedTelemetry -> Bool
(ResolvedTelemetry -> ResolvedTelemetry -> Bool)
-> (ResolvedTelemetry -> ResolvedTelemetry -> Bool)
-> Eq ResolvedTelemetry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResolvedTelemetry -> ResolvedTelemetry -> Bool
== :: ResolvedTelemetry -> ResolvedTelemetry -> Bool
$c/= :: ResolvedTelemetry -> ResolvedTelemetry -> Bool
/= :: ResolvedTelemetry -> ResolvedTelemetry -> Bool
Eq, Int -> ResolvedTelemetry -> ShowS
[ResolvedTelemetry] -> ShowS
ResolvedTelemetry -> String
(Int -> ResolvedTelemetry -> ShowS)
-> (ResolvedTelemetry -> String)
-> ([ResolvedTelemetry] -> ShowS)
-> Show ResolvedTelemetry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolvedTelemetry -> ShowS
showsPrec :: Int -> ResolvedTelemetry -> ShowS
$cshow :: ResolvedTelemetry -> String
show :: ResolvedTelemetry -> String
$cshowList :: [ResolvedTelemetry] -> ShowS
showList :: [ResolvedTelemetry] -> ShowS
Show)

{- | Resolve the telemetry identity, each field falling __Datadog value, then vanilla
OpenTelemetry, then the default__. The resolver never reads @DD_API_KEY@ or @DD_SITE@.

>>> rtServiceName (resolveTelemetry [("DD_SERVICE", "api"), ("OTEL_SERVICE_NAME", "ignored")])
"api"

>>> teUrl (rtEndpoint (resolveTelemetry []))
"http://localhost:4318"
-}
resolveTelemetry :: [(String, String)] -> ResolvedTelemetry
resolveTelemetry :: [(String, String)] -> ResolvedTelemetry
resolveTelemetry [(String, String)]
environment =
    ResolvedTelemetry
        { rtServiceName :: Text
rtServiceName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
defaultServiceName Maybe Text
serviceName
        , rtEnvironment :: Maybe Text
rtEnvironment = Maybe Text
deploymentEnvironment
        , rtVersion :: Maybe Text
rtVersion = String -> Maybe Text
declared String
"DD_VERSION" Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
attr Text
"service.version" Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
productVersion
        , rtEndpoint :: TelemetryEndpoint
rtEndpoint = TelemetryEndpoint
endpoint
        }
  where
    declared :: String -> Maybe Text
    declared :: String -> Maybe Text
declared String
name = String -> [(String, String)] -> Maybe Text
declaredEnv String
name [(String, String)]
environment

    attributes :: Baggage
    attributes :: Baggage
attributes = Baggage -> Either Text Baggage -> Baggage
forall b a. b -> Either a b -> b
fromRight Baggage
Baggage.empty ([(String, String)] -> Either Text Baggage
decodeResourceAttributes [(String, String)]
environment)

    attr :: Text -> Maybe Text
    attr :: Text -> Maybe Text
attr Text
key = do
        name <- Text -> Maybe Token
Baggage.mkToken Text
key
        nonBlank =<< Baggage.getValue name attributes

    serviceName :: Maybe Text
    serviceName :: Maybe Text
serviceName = String -> Maybe Text
declared String
"DD_SERVICE" Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe Text
declared String
"OTEL_SERVICE_NAME" Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
attr Text
"service.name"

    -- The SDK deprecates deployment.environment for deployment.environment.name. Both spellings
    -- are read, so an operator on either one resolves, and only the current spelling is emitted.
    deploymentEnvironment :: Maybe Text
    deploymentEnvironment :: Maybe Text
deploymentEnvironment =
        String -> Maybe Text
declared String
"DD_ENV" Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
attr Text
"deployment.environment.name" Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
attr Text
"deployment.environment"

    endpoint :: TelemetryEndpoint
    endpoint :: TelemetryEndpoint
endpoint = case String -> Maybe Text
declared String
"DD_AGENT_HOST" of
        Just Text
host -> Text -> EndpointSource -> TelemetryEndpoint
TelemetryEndpoint (Text -> Text
agentHostUrl Text
host) EndpointSource
FromDdAgentHost
        Maybe Text
Nothing -> case String -> Maybe Text
declared String
"OTEL_EXPORTER_OTLP_ENDPOINT" of
            Just Text
url -> Text -> EndpointSource -> TelemetryEndpoint
TelemetryEndpoint Text
url EndpointSource
FromOtelEndpoint
            Maybe Text
Nothing -> Text -> EndpointSource -> TelemetryEndpoint
TelemetryEndpoint Text
defaultEndpointUrl EndpointSource
DefaultedEndpoint

-- | Read one environment variable, counting a present but blank value as unset.
declaredEnv :: String -> [(String, String)] -> Maybe Text
declaredEnv :: String -> [(String, String)] -> Maybe Text
declaredEnv String
name [(String, String)]
environment = Text -> Maybe Text
nonBlank (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Maybe Text) -> Maybe String -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, String)]
environment

defaultServiceName :: Text
defaultServiceName :: Text
defaultServiceName = Text
"ecluse"

defaultEndpointUrl :: Text
defaultEndpointUrl :: Text
defaultEndpointUrl = Text
"http://localhost:4318"

{- The Datadog Agent's OTLP receiver listens on 4318 for HTTP\/protobuf. A literal IPv6 host is
bracketed so the authority stays well-formed, and a host with a scheme or a port passes unchanged. -}
agentHostUrl :: Text -> Text
agentHostUrl :: Text -> Text
agentHostUrl Text
raw
    | Text
"://" Text -> Text -> Bool
`T.isInfixOf` Text
host = Text
host
    | Bool
otherwise = Text
"http://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
authority
  where
    host :: Text
host = Text -> Text
T.strip Text
raw
    authority :: Text
authority
        | Text
"[" Text -> Text -> Bool
`T.isPrefixOf` Text
host = if Text
"]:" Text -> Text -> Bool
`T.isInfixOf` Text
host then Text
host else Text
host Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":4318"
        | HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
":" Text
host Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
host Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]:4318"
        | HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
":" Text
host Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Text
host
        | Bool
otherwise = Text
host Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":4318"

{- | Project the resolved identity back to the canonical @OTEL_*@ variables the env-driven SDK
reads. The protocol is pinned to @http\/protobuf@ because gRPC sits behind a disabled cabal flag.
-}
otelEnvironmentOverrides :: [(String, String)] -> [(String, String)]
otelEnvironmentOverrides :: [(String, String)] -> [(String, String)]
otelEnvironmentOverrides [(String, String)]
environment =
    [ (String
"OTEL_SERVICE_NAME", Text -> String
forall a. ToString a => a -> String
toString (ResolvedTelemetry -> Text
rtServiceName ResolvedTelemetry
resolved))
    , (String
"OTEL_EXPORTER_OTLP_ENDPOINT", Text -> String
forall a. ToString a => a -> String
toString (TelemetryEndpoint -> Text
teUrl (ResolvedTelemetry -> TelemetryEndpoint
rtEndpoint ResolvedTelemetry
resolved)))
    , (String
"OTEL_EXPORTER_OTLP_PROTOCOL", String
"http/protobuf")
    , (String
"OTEL_RESOURCE_ATTRIBUTES", Baggage -> String
renderResourceAttributes (ResourceAttributes -> Baggage
raCarried ([(String, String)] -> ResourceAttributes
resourceAttributes [(String, String)]
environment)))
    ]
  where
    resolved :: ResolvedTelemetry
    resolved :: ResolvedTelemetry
resolved = [(String, String)] -> ResolvedTelemetry
resolveTelemetry [(String, String)]
environment

-- Overlay the resolved identity onto the operator's own attributes. An inserted member replaces
-- an inherited one of the same name, so a stale operator value never overrides the resolution.
mergedResourceAttributes :: ResolvedTelemetry -> [(String, String)] -> Baggage
mergedResourceAttributes :: ResolvedTelemetry -> [(String, String)] -> Baggage
mergedResourceAttributes ResolvedTelemetry
resolved [(String, String)]
environment =
    ((Text, Text) -> Baggage -> Baggage)
-> Baggage -> [(Text, Text)] -> Baggage
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, Text) -> Baggage -> Baggage
insertAttribute Baggage
withoutServiceName (ResolvedTelemetry -> [(Text, Text)]
resolvedAttributes ResolvedTelemetry
resolved)
  where
    inherited :: Baggage
    inherited :: Baggage
inherited = Baggage -> Either Text Baggage -> Baggage
forall b a. b -> Either a b -> b
fromRight Baggage
Baggage.empty ([(String, String)] -> Either Text Baggage
decodeResourceAttributes [(String, String)]
environment)

    -- OTEL_SERVICE_NAME carries the service name, and every SDK signal path prefers that
    -- variable, so an inherited copy here spends header budget to fight it and lose.
    withoutServiceName :: Baggage
    withoutServiceName :: Baggage
withoutServiceName = Baggage -> (Token -> Baggage) -> Maybe Token -> Baggage
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Baggage
inherited (Token -> Baggage -> Baggage
`Baggage.delete` Baggage
inherited) (Text -> Maybe Token
Baggage.mkToken Text
"service.name")

resolvedAttributes :: ResolvedTelemetry -> [(Text, Text)]
resolvedAttributes :: ResolvedTelemetry -> [(Text, Text)]
resolvedAttributes ResolvedTelemetry
resolved =
    [ (Text
key, Text
value)
    | (Text
key, Just Text
value) <-
        [ (Text
"deployment.environment.name", ResolvedTelemetry -> Maybe Text
rtEnvironment ResolvedTelemetry
resolved)
        , (Text
"service.version", ResolvedTelemetry -> Maybe Text
rtVersion ResolvedTelemetry
resolved)
        ]
    ]

-- A key the W3C token grammar cannot express is dropped, because the SDK's decoder rejects a
-- whole header over one such member.
insertAttribute :: (Text, Text) -> Baggage -> Baggage
insertAttribute :: (Text, Text) -> Baggage -> Baggage
insertAttribute (Text
key, Text
value) Baggage
bag =
    Baggage -> (Token -> Baggage) -> Maybe Token -> Baggage
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Baggage
bag (\Token
name -> Token -> Element -> Baggage -> Baggage
Baggage.insert Token
name (Text -> Element
Baggage.element Text
value) Baggage
bag) (Text -> Maybe Token
Baggage.mkToken Text
key)

-- | The members the exported header carries, and the keys the W3C baggage limits left out.
data ResourceAttributes = ResourceAttributes
    { ResourceAttributes -> Baggage
raCarried :: Baggage
    -- ^ What @OTEL_RESOURCE_ATTRIBUTES@ exports.
    , ResourceAttributes -> [Text]
raDropped :: [Text]
    -- ^ The keys the limits excluded, in admission order.
    }
    deriving stock (ResourceAttributes -> ResourceAttributes -> Bool
(ResourceAttributes -> ResourceAttributes -> Bool)
-> (ResourceAttributes -> ResourceAttributes -> Bool)
-> Eq ResourceAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceAttributes -> ResourceAttributes -> Bool
== :: ResourceAttributes -> ResourceAttributes -> Bool
$c/= :: ResourceAttributes -> ResourceAttributes -> Bool
/= :: ResourceAttributes -> ResourceAttributes -> Bool
Eq, Int -> ResourceAttributes -> ShowS
[ResourceAttributes] -> ShowS
ResourceAttributes -> String
(Int -> ResourceAttributes -> ShowS)
-> (ResourceAttributes -> String)
-> ([ResourceAttributes] -> ShowS)
-> Show ResourceAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceAttributes -> ShowS
showsPrec :: Int -> ResourceAttributes -> ShowS
$cshow :: ResourceAttributes -> String
show :: ResourceAttributes -> String
$cshowList :: [ResourceAttributes] -> ShowS
showList :: [ResourceAttributes] -> ShowS
Show)

{- | Decide what the exported header carries. The SDK's encoder would shed the overflow in hash
order, so the choice is made here: the carried set is stable and every shed key warns at boot.
-}
resourceAttributes :: [(String, String)] -> ResourceAttributes
resourceAttributes :: [(String, String)] -> ResourceAttributes
resourceAttributes [(String, String)]
environment = ([(Token, Element)], [Text]) -> ResourceAttributes
carry (Int -> Int -> [(Token, Element)] -> ([(Token, Element)], [Text])
admitMembers Int
0 Int
0 (ResolvedTelemetry -> Baggage -> [(Token, Element)]
admissionOrder ResolvedTelemetry
resolved Baggage
merged))
  where
    resolved :: ResolvedTelemetry
    resolved :: ResolvedTelemetry
resolved = [(String, String)] -> ResolvedTelemetry
resolveTelemetry [(String, String)]
environment

    merged :: Baggage
    merged :: Baggage
merged = ResolvedTelemetry -> [(String, String)] -> Baggage
mergedResourceAttributes ResolvedTelemetry
resolved [(String, String)]
environment

    carry :: ([(Token, Element)], [Text]) -> ResourceAttributes
    carry :: ([(Token, Element)], [Text]) -> ResourceAttributes
carry ([(Token, Element)]
kept, [Text]
dropped) = Baggage -> [Text] -> ResourceAttributes
ResourceAttributes (((Token, Element) -> Baggage -> Baggage)
-> Baggage -> [(Token, Element)] -> Baggage
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Token -> Element -> Baggage -> Baggage)
-> (Token, Element) -> Baggage -> Baggage
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Token -> Element -> Baggage -> Baggage
Baggage.insert) Baggage
Baggage.empty [(Token, Element)]
kept) [Text]
dropped

-- The resolved identity is offered first, so the limits shed the operator's extras rather than
-- the keys a dashboard joins on. Everything else follows in key order.
admissionOrder :: ResolvedTelemetry -> Baggage -> [(Token, Element)]
admissionOrder :: ResolvedTelemetry -> Baggage -> [(Token, Element)]
admissionOrder ResolvedTelemetry
resolved Baggage
bag = ((Token, Element) -> (Int, Text))
-> [(Token, Element)] -> [(Token, Element)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> (Int, Text)
rank (Text -> (Int, Text))
-> ((Token, Element) -> Text) -> (Token, Element) -> (Int, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Text
memberKey (Token -> Text)
-> ((Token, Element) -> Token) -> (Token, Element) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token, Element) -> Token
forall a b. (a, b) -> a
fst) (HashMap Token Element -> [Item (HashMap Token Element)]
forall l. IsList l => l -> [Item l]
Exts.toList (Baggage -> HashMap Token Element
Baggage.values Baggage
bag))
  where
    identityKeys :: [Text]
    identityKeys :: [Text]
identityKeys = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst (ResolvedTelemetry -> [(Text, Text)]
resolvedAttributes ResolvedTelemetry
resolved)

    rank :: Text -> (Int, Text)
    rank :: Text -> (Int, Text)
rank Text
key = (if Text
key Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
identityKeys then Int
0 else Int
1, Text
key)

{- Take members while the W3C limits allow and name the rest. An excluded member is skipped rather
than ending the scan, so a small attribute still lands after a large one is left out. -}
admitMembers :: Int -> Int -> [(Token, Element)] -> ([(Token, Element)], [Text])
admitMembers :: Int -> Int -> [(Token, Element)] -> ([(Token, Element)], [Text])
admitMembers Int
_ Int
_ [] = ([], [])
admitMembers Int
usedBytes Int
usedMembers ((Token
tok, Element
el) : [(Token, Element)]
rest)
    | Bool
admissible = ([(Token, Element)] -> [(Token, Element)])
-> ([(Token, Element)], [Text]) -> ([(Token, Element)], [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Token
tok, Element
el) (Token, Element) -> [(Token, Element)] -> [(Token, Element)]
forall a. a -> [a] -> [a]
:) (Int -> Int -> [(Token, Element)] -> ([(Token, Element)], [Text])
admitMembers (Int
usedBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
separator Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size) (Int
usedMembers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(Token, Element)]
rest)
    | Bool
otherwise = ([Text] -> [Text])
-> ([(Token, Element)], [Text]) -> ([(Token, Element)], [Text])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Token -> Text
memberKey Token
tok Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) (Int -> Int -> [(Token, Element)] -> ([(Token, Element)], [Text])
admitMembers Int
usedBytes Int
usedMembers [(Token, Element)]
rest)
  where
    size :: Int
    size :: Int
size = Token -> Element -> Int
encodedMemberBytes Token
tok Element
el

    separator :: Int
    separator :: Int
separator = if Int
usedMembers Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1

    admissible :: Bool
    admissible :: Bool
admissible =
        Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Baggage.maxMemberBytes
            Bool -> Bool -> Bool
&& Int
usedMembers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
Baggage.maxMembers
            Bool -> Bool -> Bool
&& Int
usedBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
separator Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Baggage.maxBaggageBytes

-- One member's encoded size, measured with the SDK's own encoder. That encoder emits nothing for a
-- member over its per-member limit, so an empty encoding reports as one byte past the limit.
encodedMemberBytes :: Token -> Element -> Int
encodedMemberBytes :: Token -> Element -> Int
encodedMemberBytes Token
tok Element
el =
    case ByteString -> Int
BS.length (Baggage -> ByteString
Baggage.encodeBaggageHeader (Token -> Element -> Baggage -> Baggage
Baggage.insert Token
tok Element
el Baggage
Baggage.empty)) of
        Int
0 -> Int
Baggage.maxMemberBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        Int
n -> Int
n

memberKey :: Token -> Text
memberKey :: Token -> Text
memberKey = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> (Token -> ByteString) -> Token -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ByteString
Baggage.tokenValue

{- Decode @OTEL_RESOURCE_ATTRIBUTES@ with the SDK's own W3C baggage parser. Blank members are
dropped first, so a trailing comma parses where the grammar alone would reject the whole value. -}
decodeResourceAttributes :: [(String, String)] -> Either Text Baggage
decodeResourceAttributes :: [(String, String)] -> Either Text Baggage
decodeResourceAttributes [(String, String)]
environment = case [Text]
members of
    [] -> Baggage -> Either Text Baggage
forall a b. b -> Either a b
Right Baggage
Baggage.empty
    [Text]
_ -> (String -> Text) -> Either String Baggage -> Either Text Baggage
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
forall a. ToText a => a -> Text
toText (ByteString -> Either String Baggage
Baggage.decodeBaggageHeader (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> [Text] -> Text
T.intercalate Text
"," [Text]
members)))
  where
    members :: [Text]
    members :: [Text]
members = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
raw))

    raw :: Text
    raw :: Text
raw = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
forall a. ToText a => a -> Text
toText (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"OTEL_RESOURCE_ATTRIBUTES" [(String, String)]
environment)

-- Render with the SDK's own encoder, so the value the SDK decodes is the one this module resolved.
-- 'resourceAttributes' has already brought the bag within the limits, so nothing is shed here.
renderResourceAttributes :: Baggage -> String
renderResourceAttributes :: Baggage -> String
renderResourceAttributes = ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> String)
-> (Baggage -> ByteString) -> Baggage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> ByteString
Baggage.encodeBaggageHeader

-- | The boot warnings the environment raises, in the order 'prepareTelemetry' surfaces them.
telemetryWarnings :: [(String, String)] -> [Text]
telemetryWarnings :: [(String, String)] -> [Text]
telemetryWarnings [(String, String)]
environment = [Text]
endpointWarning [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
attributeWarning [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
droppedWarning
  where
    endpoint :: TelemetryEndpoint
    endpoint :: TelemetryEndpoint
endpoint = ResolvedTelemetry -> TelemetryEndpoint
rtEndpoint ([(String, String)] -> ResolvedTelemetry
resolveTelemetry [(String, String)]
environment)

    endpointWarning :: [Text]
    endpointWarning :: [Text]
endpointWarning =
        [Text -> Text
defaultedEndpointMessage (TelemetryEndpoint -> Text
teUrl TelemetryEndpoint
endpoint) | TelemetryEndpoint -> EndpointSource
teSource TelemetryEndpoint
endpoint EndpointSource -> EndpointSource -> Bool
forall a. Eq a => a -> a -> Bool
== EndpointSource
DefaultedEndpoint]

    attributeWarning :: [Text]
    attributeWarning :: [Text]
attributeWarning =
        (Text -> [Text])
-> (Baggage -> [Text]) -> Either Text Baggage -> [Text]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\Text
reason -> [Text -> Text
malformedAttributesMessage Text
reason])
            ([Text] -> Baggage -> [Text]
forall a b. a -> b -> a
const [])
            ([(String, String)] -> Either Text Baggage
decodeResourceAttributes [(String, String)]
environment)

    droppedWarning :: [Text]
    droppedWarning :: [Text]
droppedWarning = case ResourceAttributes -> [Text]
raDropped ([(String, String)] -> ResourceAttributes
resourceAttributes [(String, String)]
environment) of
        [] -> []
        [Text]
dropped -> [[Text] -> Text
droppedAttributesMessage [Text]
dropped]

defaultedEndpointMessage :: Text -> Text
defaultedEndpointMessage :: Text -> Text
defaultedEndpointMessage Text
url =
    Text
"no telemetry export endpoint configured (DD_AGENT_HOST / OTEL_EXPORTER_OTLP_ENDPOINT unset); defaulting to "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."

malformedAttributesMessage :: Text -> Text
malformedAttributesMessage :: Text -> Text
malformedAttributesMessage Text
reason =
    Text
"OTEL_RESOURCE_ATTRIBUTES is not valid W3C baggage ("
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"). Dropping its attributes and exporting the resolved service identity alone."

droppedAttributesMessage :: [Text] -> Text
droppedAttributesMessage :: [Text] -> Text
droppedAttributesMessage [Text]
dropped =
    Text
"OTEL_RESOURCE_ATTRIBUTES is over the W3C baggage limits ("
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
Baggage.maxBaggageBytes
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes total, "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
Baggage.maxMemberBytes
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes per member, "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
Baggage.maxMembers
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" members). Dropping "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
dropped
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from the exported resource attributes."

{- | Surface the boot warnings and set the canonical @OTEL_*@ environment, before the SDK reads it.
A defaulted endpoint is a warning and never a failure: the destination is the operator's to declare.
-}
prepareTelemetry :: LogEnv -> [(String, String)] -> IO ()
prepareTelemetry :: LogEnv -> [(String, String)] -> IO ()
prepareTelemetry LogEnv
logEnv [(String, String)]
environment = do
    (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LogEnv -> Text -> Severity -> Text -> IO ()
moduleLog LogEnv
logEnv Text
resolveModule Severity
WarningS) ([(String, String)] -> [Text]
telemetryWarnings [(String, String)]
environment)
    ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
setEnv) ([(String, String)] -> [(String, String)]
otelEnvironmentOverrides [(String, String)]
environment)

-- The operator filter key every line raised here is tagged with. It names the public module,
-- not this one, because operators filter on it.
resolveModule :: Text
resolveModule :: Text
resolveModule = Text
"Ecluse.Runtime.Telemetry.Resolve"