{-# LANGUAGE OverloadedStrings #-}

module OpenTelemetry.SemanticsConfig (
  SemanticsOptions (httpOption),
  HttpOption (..),
  getSemanticsOptions,
  getSemanticsOptions',
) where

import Control.Exception.Safe (throwIO, tryAny)
import Data.IORef (newIORef, readIORef, writeIORef)
import qualified Data.Text as T
import System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)


{- | This is a record that contains options for whether the new stable semantics conventions should be emitted.
Semantics conventions that have been declared stable:
- [http](https://opentelemetry.io/blog/2023/http-conventions-declared-stable/#migration-plan)
-}
data SemanticsOptions = SemanticsOptions {SemanticsOptions -> HttpOption
httpOption :: HttpOption}


-- | This option determines whether stable, old, or both kinds of http attributes are emitted.
data HttpOption
  = Stable
  | StableAndOld
  | Old
  deriving (Int -> HttpOption -> ShowS
[HttpOption] -> ShowS
HttpOption -> String
(Int -> HttpOption -> ShowS)
-> (HttpOption -> String)
-> ([HttpOption] -> ShowS)
-> Show HttpOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HttpOption -> ShowS
showsPrec :: Int -> HttpOption -> ShowS
$cshow :: HttpOption -> String
show :: HttpOption -> String
$cshowList :: [HttpOption] -> ShowS
showList :: [HttpOption] -> ShowS
Show, HttpOption -> HttpOption -> Bool
(HttpOption -> HttpOption -> Bool)
-> (HttpOption -> HttpOption -> Bool) -> Eq HttpOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HttpOption -> HttpOption -> Bool
== :: HttpOption -> HttpOption -> Bool
$c/= :: HttpOption -> HttpOption -> Bool
/= :: HttpOption -> HttpOption -> Bool
Eq)


-- | These are the default values emitted if OTEL_SEM_CONV_STABILITY_OPT_IN is unset or does not contain values for a specific category of option.
defaultOptions :: SemanticsOptions
defaultOptions :: SemanticsOptions
defaultOptions = SemanticsOptions {httpOption :: HttpOption
httpOption = HttpOption
Old}


-- | Detects the presence of "http/dup" or "http" in OTEL_SEMCONV_STABILITY_OPT_IN or uses the default option if they are not there.
parseHttpOption :: (Foldable t) => t T.Text -> HttpOption
parseHttpOption :: forall (t :: * -> *). Foldable t => t Text -> HttpOption
parseHttpOption t Text
envs
  | Text
"http/dup" Text -> t Text -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
envs = HttpOption
StableAndOld
  | Text
"http" Text -> t Text -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
envs = HttpOption
Stable
  | Bool
otherwise = SemanticsOptions -> HttpOption
httpOption SemanticsOptions
defaultOptions


-- | Detects the presence of semantics options in OTEL_SEMCONV_STABILITY_OPT_IN or uses the defaultOptions if they are not present.
parseSemanticsOptions :: Maybe String -> SemanticsOptions
parseSemanticsOptions :: Maybe String -> SemanticsOptions
parseSemanticsOptions Maybe String
Nothing = SemanticsOptions
defaultOptions
parseSemanticsOptions (Just String
env) = SemanticsOptions {HttpOption
httpOption :: HttpOption
httpOption :: HttpOption
..}
  where
    envs :: [Text]
envs = (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
    httpOption :: HttpOption
httpOption = [Text] -> HttpOption
forall (t :: * -> *). Foldable t => t Text -> HttpOption
parseHttpOption [Text]
envs


{- | 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.
-}
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"


{- | Create a new memoized IO action using an 'IORef' under the surface. Note that
the action may be run in multiple threads simultaneously, so this may not be
thread safe (depending on the underlying action). For the sake of reading an environment
variable and parsing some stuff, we don't have to be concerned about thread-safety.
-}
memoize :: IO a -> IO (IO a)
memoize :: forall a. IO a -> IO (IO a)
memoize IO a
action = do
  IORef (Maybe (Either SomeException a))
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
  IO a -> IO (IO a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO a -> IO (IO a)) -> IO a -> IO (IO a)
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Either SomeException a)
mres <- IORef (Maybe (Either SomeException a))
-> IO (Maybe (Either SomeException a))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Either SomeException a))
ref
    Either SomeException a
res <- case Maybe (Either SomeException a)
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
        Either SomeException a
res <- IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny IO a
action
        IORef (Maybe (Either SomeException a))
-> Maybe (Either SomeException a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Either SomeException a))
ref (Maybe (Either SomeException a) -> IO ())
-> Maybe (Either SomeException a) -> IO ()
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
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
    (SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwIO a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
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 OTEL_SEMCONV_STABILITY_OPT_IN every time the
function is called.
-}
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 #-}