{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

{- |
Module      : OpenTelemetry.SemanticsConfig
Description : Configuration for semantic convention stability opt-in. Controls which attribute naming conventions are used.
Stability   : experimental

Values are typically derived from @OTEL_SEMCONV_STABILITY_OPT_IN@ via
'getSemanticsOptions' and queried per signal area with 'lookupStability'.
-}
module OpenTelemetry.SemanticsConfig (
  SemanticsOptions,
  StabilityOpt (..),
  HttpOption,
  lookupStability,

  -- * Well-known stability keys
  httpOption,
  databaseOption,
  codeOption,

  -- * Reading from the environment
  getSemanticsOptions,
  getSemanticsOptions',
) where

import Control.Exception (SomeException, throwIO, try)
import qualified Data.HashSet as Set
import Data.IORef (newIORef, readIORef, writeIORef)
import qualified Data.Text as T
import System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)


{- | Parsed representation of @OTEL_SEMCONV_STABILITY_OPT_IN@.

This is opaque: use 'lookupStability' with any signal key (e.g. @"http"@,
@"database"@, @"messaging"@) to query whether stable, old, or both conventions
should be emitted. Well-known accessors 'httpOption' and 'databaseOption' are
provided for convenience; third-party instrumentation libraries can query
arbitrary keys without modifying this module.

@since 0.4.0.0
-}
newtype SemanticsOptions = SemanticsOptions (Set.HashSet T.Text)


{- | Stability setting for a particular semantic convention area.

* 'Stable': emit only the new stable conventions.
* 'StableAndOld': emit both old and stable conventions (migration/dup mode).
* 'Old': emit only the legacy conventions (default when unset).

@since 0.4.0.0
-}
data StabilityOpt
  = Stable
  | StableAndOld
  | Old
  deriving (Int -> StabilityOpt -> ShowS
[StabilityOpt] -> ShowS
StabilityOpt -> String
(Int -> StabilityOpt -> ShowS)
-> (StabilityOpt -> String)
-> ([StabilityOpt] -> ShowS)
-> Show StabilityOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StabilityOpt -> ShowS
showsPrec :: Int -> StabilityOpt -> ShowS
$cshow :: StabilityOpt -> String
show :: StabilityOpt -> String
$cshowList :: [StabilityOpt] -> ShowS
showList :: [StabilityOpt] -> ShowS
Show, StabilityOpt -> StabilityOpt -> Bool
(StabilityOpt -> StabilityOpt -> Bool)
-> (StabilityOpt -> StabilityOpt -> Bool) -> Eq StabilityOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StabilityOpt -> StabilityOpt -> Bool
== :: StabilityOpt -> StabilityOpt -> Bool
$c/= :: StabilityOpt -> StabilityOpt -> Bool
/= :: StabilityOpt -> StabilityOpt -> Bool
Eq)


{- | Backward-compatible alias.

@since 0.4.0.0
-}
type HttpOption = StabilityOpt


{- | Look up the stability setting for an arbitrary signal key.

Given a key like @"http"@, @"database"@, @"messaging"@, etc., returns:

* 'StableAndOld' if @\<key\>\/dup@ is present in the env var
* 'Stable' if @\<key\>@ is present
* 'Old' otherwise

@
opts <- getSemanticsOptions
case lookupStability "messaging" opts of
  Stable      -> emitStableAttrs
  StableAndOld -> emitStableAttrs >> emitOldAttrs
  Old         -> emitOldAttrs
@
@since 0.4.0.0
-}
lookupStability :: T.Text -> SemanticsOptions -> StabilityOpt
lookupStability :: Text -> SemanticsOptions -> StabilityOpt
lookupStability Text
key (SemanticsOptions HashSet Text
vals)
  | (Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/dup") Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet Text
vals = StabilityOpt
StableAndOld
  | Text
key Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet Text
vals = StabilityOpt
Stable
  | Bool
otherwise = StabilityOpt
Old


{- | Stability setting for HTTP semantic conventions (@"http"@ / @"http\/dup"@).

@since 0.4.0.0
-}
httpOption :: SemanticsOptions -> StabilityOpt
httpOption :: SemanticsOptions -> StabilityOpt
httpOption = Text -> SemanticsOptions -> StabilityOpt
lookupStability Text
"http"


{- | Stability setting for database semantic conventions (@"database"@ / @"database\/dup"@).

@since 0.4.0.0
-}
databaseOption :: SemanticsOptions -> StabilityOpt
databaseOption :: SemanticsOptions -> StabilityOpt
databaseOption = Text -> SemanticsOptions -> StabilityOpt
lookupStability Text
"database"


{- | Stability setting for code source-location conventions (@"code"@ / @"code\/dup"@).

Controls whether @code.function.name@, @code.file.path@, @code.line.number@ (stable)
or @code.function@, @code.namespace@, @code.filepath@, @code.lineno@ (legacy) are emitted.

@since 0.5.0.0
-}
codeOption :: SemanticsOptions -> StabilityOpt
codeOption :: SemanticsOptions -> StabilityOpt
codeOption = Text -> SemanticsOptions -> StabilityOpt
lookupStability Text
"code"


parseSemanticsOptions :: Maybe String -> SemanticsOptions
parseSemanticsOptions :: Maybe String -> SemanticsOptions
parseSemanticsOptions Maybe String
Nothing = HashSet Text -> SemanticsOptions
SemanticsOptions HashSet Text
forall a. HashSet a
Set.empty
parseSemanticsOptions (Just String
env) =
  HashSet Text -> SemanticsOptions
SemanticsOptions (HashSet Text -> SemanticsOptions)
-> HashSet Text -> SemanticsOptions
forall a b. (a -> b) -> a -> b
$ [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
env


{- | Version of 'getSemanticsOptions' that is not memoized. It is recommended to
use 'getSemanticsOptions' for efficiency purposes unless it is necessary to
retrieve the value of @OTEL_SEMCONV_STABILITY_OPT_IN@ every time
'getSemanticsOptions'' is called.

@since 0.4.0.0
-}
getSemanticsOptions' :: IO SemanticsOptions
getSemanticsOptions' :: IO SemanticsOptions
getSemanticsOptions' = Maybe String -> SemanticsOptions
parseSemanticsOptions (Maybe String -> SemanticsOptions)
-> IO (Maybe String) -> IO SemanticsOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"OTEL_SEMCONV_STABILITY_OPT_IN"


memoize :: IO a -> IO (IO a)
memoize :: forall a. IO a -> IO (IO a)
memoize IO a
action = do
  ref <- Maybe (Either SomeException a)
-> IO (IORef (Maybe (Either SomeException a)))
forall a. a -> IO (IORef a)
newIORef Maybe (Either SomeException a)
forall a. Maybe a
Nothing
  pure $ do
    mres <- readIORef ref
    res <- case mres of
      Just Either SomeException a
res -> Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
      Maybe (Either SomeException a)
Nothing -> do
        res <- forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException IO a
action
        writeIORef ref $ Just res
        pure res
    either throwIO pure res


{- | Retrieves @OTEL_SEMCONV_STABILITY_OPT_IN@ and parses it into 'SemanticsOptions'.

This uses the
[global IORef trick](https://www.parsonsmatt.org/2021/04/21/global_ioref_in_template_haskell.html)
to memoize the settings for efficiency. Note that 'getSemanticsOptions' stores
and returns the value of the first time it was called and will not change when
@OTEL_SEMCONV_STABILITY_OPT_IN@ is updated. Use 'getSemanticsOptions'' to read
the env var every time the function is called.

@since 0.4.0.0
-}
getSemanticsOptions :: IO SemanticsOptions
getSemanticsOptions :: IO SemanticsOptions
getSemanticsOptions = IO (IO SemanticsOptions) -> IO SemanticsOptions
forall a. IO a -> a
unsafePerformIO (IO (IO SemanticsOptions) -> IO SemanticsOptions)
-> IO (IO SemanticsOptions) -> IO SemanticsOptions
forall a b. (a -> b) -> a -> b
$ IO SemanticsOptions -> IO (IO SemanticsOptions)
forall a. IO a -> IO (IO a)
memoize IO SemanticsOptions
getSemanticsOptions'
{-# NOINLINE getSemanticsOptions #-}