{-# LANGUAGE OverloadedStrings #-}

module OpenTelemetry.Lightstep.Config where

import Control.Monad.IO.Class
import Data.Foldable
import Data.Maybe
import qualified Data.Text as T
import Network.Socket
import System.Environment
import System.IO

data LightstepConfig = LightstepConfig
  { LightstepConfig -> HostName
lsHostName :: HostName,
    LightstepConfig -> PortNumber
lsPort :: PortNumber,
    LightstepConfig -> Text
lsToken :: T.Text,
    LightstepConfig -> Text
lsServiceName :: T.Text,
    LightstepConfig -> [(Text, Text)]
lsGlobalTags :: [(T.Text, T.Text)],
    LightstepConfig -> Word
lsGracefulShutdownTimeoutSeconds :: Word,
    LightstepConfig -> Word
lsSpanQueueSize :: Word
  }

lookupOneOfEnvs :: [String] -> IO (Maybe String)
lookupOneOfEnvs :: [HostName] -> IO (Maybe HostName)
lookupOneOfEnvs [HostName]
names = [Maybe HostName] -> Maybe HostName
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe HostName] -> Maybe HostName)
-> IO [Maybe HostName] -> IO (Maybe HostName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HostName -> IO (Maybe HostName))
-> [HostName] -> IO [Maybe HostName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse HostName -> IO (Maybe HostName)
lookupEnv [HostName]
names

getEnvTagsWithPrefix :: T.Text -> IO [(T.Text, T.Text)]
getEnvTagsWithPrefix :: Text -> IO [(Text, Text)]
getEnvTagsWithPrefix Text
prefix =
  ((HostName, HostName) -> Maybe (Text, Text))
-> [(HostName, HostName)] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HostName, HostName) -> Maybe (Text, Text)
unprefix ([(HostName, HostName)] -> [(Text, Text)])
-> IO [(HostName, HostName)] -> IO [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(HostName, HostName)]
getEnvironment
  where
    unprefix :: (HostName, HostName) -> Maybe (Text, Text)
unprefix ((Text -> Text -> Maybe Text
T.stripPrefix Text
prefix (Text -> Maybe Text)
-> (HostName -> Text) -> HostName -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> Text
T.pack) -> Just Text
k, HostName
v) = (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
k, HostName -> Text
T.pack HostName
v)
    unprefix (HostName, HostName)
_ = Maybe (Text, Text)
forall a. Maybe a
Nothing

getEnvConfig :: MonadIO m => m (Maybe LightstepConfig)
getEnvConfig :: m (Maybe LightstepConfig)
getEnvConfig = IO (Maybe LightstepConfig) -> m (Maybe LightstepConfig)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe LightstepConfig) -> m (Maybe LightstepConfig))
-> IO (Maybe LightstepConfig) -> m (Maybe LightstepConfig)
forall a b. (a -> b) -> a -> b
$ do
  HostName
prog_name <- IO HostName
getProgName
  Maybe HostName
maybe_token_from_env <- [HostName] -> IO (Maybe HostName)
lookupOneOfEnvs [HostName
"LIGHTSTEP_TOKEN", HostName
"LIGHTSTEP_ACCESS_TOKEN", HostName
"OPENTRACING_LIGHTSTEP_ACCESS_TOKEN"]
  [(Text, Text)]
global_tags <- Text -> IO [(Text, Text)]
getEnvTagsWithPrefix Text
"OPENTRACING_TAG_"
  case Maybe HostName
maybe_token_from_env of
    Just HostName
t -> do
      HostName
host <- HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe HostName
"ingest.lightstep.com" (Maybe HostName -> HostName) -> IO (Maybe HostName) -> IO HostName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HostName] -> IO (Maybe HostName)
lookupOneOfEnvs [HostName
"LIGHTSTEP_HOST", HostName
"OPENTRACING_LIGHTSTEP_COLLECTOR_HOST"]
      PortNumber
port <- PortNumber
-> (HostName -> PortNumber) -> Maybe HostName -> PortNumber
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PortNumber
443 HostName -> PortNumber
forall a. Read a => HostName -> a
read (Maybe HostName -> PortNumber)
-> IO (Maybe HostName) -> IO PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HostName] -> IO (Maybe HostName)
lookupOneOfEnvs [HostName
"LIGHTSTEP_PORT", HostName
"OPENTRACING_LIGHTSTEP_COLLECTOR_PORT"]
      HostName
service <- HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe HostName
prog_name (Maybe HostName -> HostName) -> IO (Maybe HostName) -> IO HostName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HostName] -> IO (Maybe HostName)
lookupOneOfEnvs [HostName
"LIGHTSTEP_SERVICE", HostName
"OPENTRACING_LIGHTSTEP_COMPONENT_NAME"]
      Maybe LightstepConfig -> IO (Maybe LightstepConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LightstepConfig -> IO (Maybe LightstepConfig))
-> Maybe LightstepConfig -> IO (Maybe LightstepConfig)
forall a b. (a -> b) -> a -> b
$ LightstepConfig -> Maybe LightstepConfig
forall a. a -> Maybe a
Just (LightstepConfig -> Maybe LightstepConfig)
-> LightstepConfig -> Maybe LightstepConfig
forall a b. (a -> b) -> a -> b
$ HostName
-> PortNumber
-> Text
-> Text
-> [(Text, Text)]
-> Word
-> Word
-> LightstepConfig
LightstepConfig HostName
host PortNumber
port (HostName -> Text
T.pack HostName
t) (HostName -> Text
T.pack HostName
service) [(Text, Text)]
global_tags Word
5 Word
4096
    Maybe HostName
Nothing -> do
      Handle -> HostName -> IO ()
hPutStrLn Handle
stderr HostName
"LIGHTSTEP_ACCESS_TOKEN environment variable not defined"
      Maybe LightstepConfig -> IO (Maybe LightstepConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LightstepConfig
forall a. Maybe a
Nothing