{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.Types.OpenTelemetry
  ( -- * User-facing configuration (metadata)
    OpenTelemetryConfig (..),
    ocStatus,
    ocEnabledDataTypes,
    ocExporterOtlp,
    ocBatchSpanProcessor,
    emptyOpenTelemetryConfig,
    OpenTelemetryConfigSubobject (..),
    OtelStatus (..),
    OtelDataType (..),
    OtelExporterConfig (..),
    defaultOtelExporterConfig,
    OtlpProtocol (..),
    OtelBatchSpanProcessorConfig (..),
    defaultOtelBatchSpanProcessorConfig,
    NameValue (..),

    -- * Parsed configuration (schema cache)
    OpenTelemetryInfo (..),
    otiExporterOtlp,
    otiBatchSpanProcessor,
    emptyOpenTelemetryInfo,
    OtelExporterInfo (..),
    getOtelExporterTracesBaseRequest,
    getOtelExporterResourceAttributes,
    OtelBatchSpanProcessorInfo (..),
    getMaxExportBatchSize,
    getMaxQueueSize,
    defaultOtelBatchSpanProcessorInfo,
  )
where

import Autodocodec (HasCodec, optionalField, optionalFieldWithDefault, optionalFieldWithDefault', requiredField', (<?>))
import Autodocodec qualified as AC
import Autodocodec.Extended (boundedEnumCodec)
import Control.Lens.TH (makeLenses)
import Data.Aeson (FromJSON, ToJSON (..), (.!=), (.:), (.:?), (.=))
import Data.Aeson qualified as J
import Data.Map.Strict (Map)
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Generics
import Hasura.Prelude hiding (first)
import Hasura.RQL.Types.Headers (HeaderConf)
import Language.Haskell.TH.Syntax (Lift)
import Network.HTTP.Client (Request)

--------------------------------------------------------------------------------

-- * User-facing configuration (metadata)

-- | Metadata configuration for all OpenTelemetry-related features
data OpenTelemetryConfig = OpenTelemetryConfig
  { OpenTelemetryConfig -> OtelStatus
_ocStatus :: OtelStatus,
    OpenTelemetryConfig -> Set OtelDataType
_ocEnabledDataTypes :: Set OtelDataType,
    OpenTelemetryConfig -> OtelExporterConfig
_ocExporterOtlp :: OtelExporterConfig,
    OpenTelemetryConfig -> OtelBatchSpanProcessorConfig
_ocBatchSpanProcessor :: OtelBatchSpanProcessorConfig
  }
  deriving stock (OpenTelemetryConfig -> OpenTelemetryConfig -> Bool
(OpenTelemetryConfig -> OpenTelemetryConfig -> Bool)
-> (OpenTelemetryConfig -> OpenTelemetryConfig -> Bool)
-> Eq OpenTelemetryConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenTelemetryConfig -> OpenTelemetryConfig -> Bool
== :: OpenTelemetryConfig -> OpenTelemetryConfig -> Bool
$c/= :: OpenTelemetryConfig -> OpenTelemetryConfig -> Bool
/= :: OpenTelemetryConfig -> OpenTelemetryConfig -> Bool
Eq, Int -> OpenTelemetryConfig -> ShowS
[OpenTelemetryConfig] -> ShowS
OpenTelemetryConfig -> String
(Int -> OpenTelemetryConfig -> ShowS)
-> (OpenTelemetryConfig -> String)
-> ([OpenTelemetryConfig] -> ShowS)
-> Show OpenTelemetryConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenTelemetryConfig -> ShowS
showsPrec :: Int -> OpenTelemetryConfig -> ShowS
$cshow :: OpenTelemetryConfig -> String
show :: OpenTelemetryConfig -> String
$cshowList :: [OpenTelemetryConfig] -> ShowS
showList :: [OpenTelemetryConfig] -> ShowS
Show)

instance HasCodec OpenTelemetryConfig where
  codec :: JSONCodec OpenTelemetryConfig
codec =
    Text
-> ObjectCodec OpenTelemetryConfig OpenTelemetryConfig
-> JSONCodec OpenTelemetryConfig
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"OpenTelemetryConfig"
      (ObjectCodec OpenTelemetryConfig OpenTelemetryConfig
 -> JSONCodec OpenTelemetryConfig)
-> ObjectCodec OpenTelemetryConfig OpenTelemetryConfig
-> JSONCodec OpenTelemetryConfig
forall a b. (a -> b) -> a -> b
$ OtelStatus
-> Set OtelDataType
-> OtelExporterConfig
-> OtelBatchSpanProcessorConfig
-> OpenTelemetryConfig
OpenTelemetryConfig
      (OtelStatus
 -> Set OtelDataType
 -> OtelExporterConfig
 -> OtelBatchSpanProcessorConfig
 -> OpenTelemetryConfig)
-> Codec Object OpenTelemetryConfig OtelStatus
-> Codec
     Object
     OpenTelemetryConfig
     (Set OtelDataType
      -> OtelExporterConfig
      -> OtelBatchSpanProcessorConfig
      -> OpenTelemetryConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> OtelStatus -> ObjectCodec OtelStatus OtelStatus
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"status" OtelStatus
defaultOtelStatus
      ObjectCodec OtelStatus OtelStatus
-> (OpenTelemetryConfig -> OtelStatus)
-> Codec Object OpenTelemetryConfig OtelStatus
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OpenTelemetryConfig -> OtelStatus
_ocStatus
        Codec
  Object
  OpenTelemetryConfig
  (Set OtelDataType
   -> OtelExporterConfig
   -> OtelBatchSpanProcessorConfig
   -> OpenTelemetryConfig)
-> Codec Object OpenTelemetryConfig (Set OtelDataType)
-> Codec
     Object
     OpenTelemetryConfig
     (OtelExporterConfig
      -> OtelBatchSpanProcessorConfig -> OpenTelemetryConfig)
forall a b.
Codec Object OpenTelemetryConfig (a -> b)
-> Codec Object OpenTelemetryConfig a
-> Codec Object OpenTelemetryConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Set OtelDataType
-> ObjectCodec (Set OtelDataType) (Set OtelDataType)
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"data_types" Set OtelDataType
defaultOtelEnabledDataTypes
      ObjectCodec (Set OtelDataType) (Set OtelDataType)
-> (OpenTelemetryConfig -> Set OtelDataType)
-> Codec Object OpenTelemetryConfig (Set OtelDataType)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OpenTelemetryConfig -> Set OtelDataType
_ocEnabledDataTypes
        Codec
  Object
  OpenTelemetryConfig
  (OtelExporterConfig
   -> OtelBatchSpanProcessorConfig -> OpenTelemetryConfig)
-> Codec Object OpenTelemetryConfig OtelExporterConfig
-> Codec
     Object
     OpenTelemetryConfig
     (OtelBatchSpanProcessorConfig -> OpenTelemetryConfig)
forall a b.
Codec Object OpenTelemetryConfig (a -> b)
-> Codec Object OpenTelemetryConfig a
-> Codec Object OpenTelemetryConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> OtelExporterConfig
-> ObjectCodec OtelExporterConfig OtelExporterConfig
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"exporter_otlp" OtelExporterConfig
defaultOtelExporterConfig
      ObjectCodec OtelExporterConfig OtelExporterConfig
-> (OpenTelemetryConfig -> OtelExporterConfig)
-> Codec Object OpenTelemetryConfig OtelExporterConfig
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OpenTelemetryConfig -> OtelExporterConfig
_ocExporterOtlp
        Codec
  Object
  OpenTelemetryConfig
  (OtelBatchSpanProcessorConfig -> OpenTelemetryConfig)
-> Codec Object OpenTelemetryConfig OtelBatchSpanProcessorConfig
-> ObjectCodec OpenTelemetryConfig OpenTelemetryConfig
forall a b.
Codec Object OpenTelemetryConfig (a -> b)
-> Codec Object OpenTelemetryConfig a
-> Codec Object OpenTelemetryConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> OtelBatchSpanProcessorConfig
-> ObjectCodec
     OtelBatchSpanProcessorConfig OtelBatchSpanProcessorConfig
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"batch_span_processor" OtelBatchSpanProcessorConfig
defaultOtelBatchSpanProcessorConfig
      ObjectCodec
  OtelBatchSpanProcessorConfig OtelBatchSpanProcessorConfig
-> (OpenTelemetryConfig -> OtelBatchSpanProcessorConfig)
-> Codec Object OpenTelemetryConfig OtelBatchSpanProcessorConfig
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OpenTelemetryConfig -> OtelBatchSpanProcessorConfig
_ocBatchSpanProcessor

instance FromJSON OpenTelemetryConfig where
  parseJSON :: Value -> Parser OpenTelemetryConfig
parseJSON = String
-> (Object -> Parser OpenTelemetryConfig)
-> Value
-> Parser OpenTelemetryConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"OpenTelemetryConfig" ((Object -> Parser OpenTelemetryConfig)
 -> Value -> Parser OpenTelemetryConfig)
-> (Object -> Parser OpenTelemetryConfig)
-> Value
-> Parser OpenTelemetryConfig
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    OtelStatus
-> Set OtelDataType
-> OtelExporterConfig
-> OtelBatchSpanProcessorConfig
-> OpenTelemetryConfig
OpenTelemetryConfig
      (OtelStatus
 -> Set OtelDataType
 -> OtelExporterConfig
 -> OtelBatchSpanProcessorConfig
 -> OpenTelemetryConfig)
-> Parser OtelStatus
-> Parser
     (Set OtelDataType
      -> OtelExporterConfig
      -> OtelBatchSpanProcessorConfig
      -> OpenTelemetryConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe OtelStatus)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status"
      Parser (Maybe OtelStatus) -> OtelStatus -> Parser OtelStatus
forall a. Parser (Maybe a) -> a -> Parser a
.!= OtelStatus
defaultOtelStatus
      Parser
  (Set OtelDataType
   -> OtelExporterConfig
   -> OtelBatchSpanProcessorConfig
   -> OpenTelemetryConfig)
-> Parser (Set OtelDataType)
-> Parser
     (OtelExporterConfig
      -> OtelBatchSpanProcessorConfig -> OpenTelemetryConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe (Set OtelDataType))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data_types"
      Parser (Maybe (Set OtelDataType))
-> Set OtelDataType -> Parser (Set OtelDataType)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Set OtelDataType
defaultOtelEnabledDataTypes
      Parser
  (OtelExporterConfig
   -> OtelBatchSpanProcessorConfig -> OpenTelemetryConfig)
-> Parser OtelExporterConfig
-> Parser (OtelBatchSpanProcessorConfig -> OpenTelemetryConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe OtelExporterConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exporter_otlp"
      Parser (Maybe OtelExporterConfig)
-> OtelExporterConfig -> Parser OtelExporterConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= OtelExporterConfig
defaultOtelExporterConfig
      Parser (OtelBatchSpanProcessorConfig -> OpenTelemetryConfig)
-> Parser OtelBatchSpanProcessorConfig
-> Parser OpenTelemetryConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe OtelBatchSpanProcessorConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"batch_span_processor"
      Parser (Maybe OtelBatchSpanProcessorConfig)
-> OtelBatchSpanProcessorConfig
-> Parser OtelBatchSpanProcessorConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= OtelBatchSpanProcessorConfig
defaultOtelBatchSpanProcessorConfig

-- No `ToJSON` instance: use `openTelemetryConfigToOrdJSON` from
-- Hasura.RQL.Types.Metadata.Serialization

emptyOpenTelemetryConfig :: OpenTelemetryConfig
emptyOpenTelemetryConfig :: OpenTelemetryConfig
emptyOpenTelemetryConfig =
  OpenTelemetryConfig
    { _ocStatus :: OtelStatus
_ocStatus = OtelStatus
defaultOtelStatus,
      _ocEnabledDataTypes :: Set OtelDataType
_ocEnabledDataTypes = Set OtelDataType
defaultOtelEnabledDataTypes,
      _ocExporterOtlp :: OtelExporterConfig
_ocExporterOtlp = OtelExporterConfig
defaultOtelExporterConfig,
      _ocBatchSpanProcessor :: OtelBatchSpanProcessorConfig
_ocBatchSpanProcessor = OtelBatchSpanProcessorConfig
defaultOtelBatchSpanProcessorConfig
    }

-- | Subsets of the fields of 'OpenTelemetryConfig', serving as metadata object
-- names for 'MetadataObjId'.
data OpenTelemetryConfigSubobject
  = -- | The entire OpenTelemetry configuration
    OtelSubobjectAll
  | OtelSubobjectExporterOtlp
  | OtelSubobjectBatchSpanProcessor
  deriving stock (OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
(OpenTelemetryConfigSubobject
 -> OpenTelemetryConfigSubobject -> Bool)
-> (OpenTelemetryConfigSubobject
    -> OpenTelemetryConfigSubobject -> Bool)
-> Eq OpenTelemetryConfigSubobject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
== :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
$c/= :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
/= :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
Eq, (forall x.
 OpenTelemetryConfigSubobject -> Rep OpenTelemetryConfigSubobject x)
-> (forall x.
    Rep OpenTelemetryConfigSubobject x -> OpenTelemetryConfigSubobject)
-> Generic OpenTelemetryConfigSubobject
forall x.
Rep OpenTelemetryConfigSubobject x -> OpenTelemetryConfigSubobject
forall x.
OpenTelemetryConfigSubobject -> Rep OpenTelemetryConfigSubobject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
OpenTelemetryConfigSubobject -> Rep OpenTelemetryConfigSubobject x
from :: forall x.
OpenTelemetryConfigSubobject -> Rep OpenTelemetryConfigSubobject x
$cto :: forall x.
Rep OpenTelemetryConfigSubobject x -> OpenTelemetryConfigSubobject
to :: forall x.
Rep OpenTelemetryConfigSubobject x -> OpenTelemetryConfigSubobject
Generic, Eq OpenTelemetryConfigSubobject
Eq OpenTelemetryConfigSubobject
-> (OpenTelemetryConfigSubobject
    -> OpenTelemetryConfigSubobject -> Ordering)
-> (OpenTelemetryConfigSubobject
    -> OpenTelemetryConfigSubobject -> Bool)
-> (OpenTelemetryConfigSubobject
    -> OpenTelemetryConfigSubobject -> Bool)
-> (OpenTelemetryConfigSubobject
    -> OpenTelemetryConfigSubobject -> Bool)
-> (OpenTelemetryConfigSubobject
    -> OpenTelemetryConfigSubobject -> Bool)
-> (OpenTelemetryConfigSubobject
    -> OpenTelemetryConfigSubobject -> OpenTelemetryConfigSubobject)
-> (OpenTelemetryConfigSubobject
    -> OpenTelemetryConfigSubobject -> OpenTelemetryConfigSubobject)
-> Ord OpenTelemetryConfigSubobject
OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Ordering
OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> OpenTelemetryConfigSubobject
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Ordering
compare :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Ordering
$c< :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
< :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
$c<= :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
<= :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
$c> :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
> :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
$c>= :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
>= :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> Bool
$cmax :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> OpenTelemetryConfigSubobject
max :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> OpenTelemetryConfigSubobject
$cmin :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> OpenTelemetryConfigSubobject
min :: OpenTelemetryConfigSubobject
-> OpenTelemetryConfigSubobject -> OpenTelemetryConfigSubobject
Ord, Int -> OpenTelemetryConfigSubobject -> ShowS
[OpenTelemetryConfigSubobject] -> ShowS
OpenTelemetryConfigSubobject -> String
(Int -> OpenTelemetryConfigSubobject -> ShowS)
-> (OpenTelemetryConfigSubobject -> String)
-> ([OpenTelemetryConfigSubobject] -> ShowS)
-> Show OpenTelemetryConfigSubobject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenTelemetryConfigSubobject -> ShowS
showsPrec :: Int -> OpenTelemetryConfigSubobject -> ShowS
$cshow :: OpenTelemetryConfigSubobject -> String
show :: OpenTelemetryConfigSubobject -> String
$cshowList :: [OpenTelemetryConfigSubobject] -> ShowS
showList :: [OpenTelemetryConfigSubobject] -> ShowS
Show)
  deriving anyclass (Eq OpenTelemetryConfigSubobject
Eq OpenTelemetryConfigSubobject
-> (Int -> OpenTelemetryConfigSubobject -> Int)
-> (OpenTelemetryConfigSubobject -> Int)
-> Hashable OpenTelemetryConfigSubobject
Int -> OpenTelemetryConfigSubobject -> Int
OpenTelemetryConfigSubobject -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> OpenTelemetryConfigSubobject -> Int
hashWithSalt :: Int -> OpenTelemetryConfigSubobject -> Int
$chash :: OpenTelemetryConfigSubobject -> Int
hash :: OpenTelemetryConfigSubobject -> Int
Hashable)

-- | Should the OpenTelemetry exporter be enabled?
data OtelStatus = OtelEnabled | OtelDisabled
  deriving stock (OtelStatus -> OtelStatus -> Bool
(OtelStatus -> OtelStatus -> Bool)
-> (OtelStatus -> OtelStatus -> Bool) -> Eq OtelStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OtelStatus -> OtelStatus -> Bool
== :: OtelStatus -> OtelStatus -> Bool
$c/= :: OtelStatus -> OtelStatus -> Bool
/= :: OtelStatus -> OtelStatus -> Bool
Eq, Int -> OtelStatus -> ShowS
[OtelStatus] -> ShowS
OtelStatus -> String
(Int -> OtelStatus -> ShowS)
-> (OtelStatus -> String)
-> ([OtelStatus] -> ShowS)
-> Show OtelStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OtelStatus -> ShowS
showsPrec :: Int -> OtelStatus -> ShowS
$cshow :: OtelStatus -> String
show :: OtelStatus -> String
$cshowList :: [OtelStatus] -> ShowS
showList :: [OtelStatus] -> ShowS
Show, OtelStatus
OtelStatus -> OtelStatus -> Bounded OtelStatus
forall a. a -> a -> Bounded a
$cminBound :: OtelStatus
minBound :: OtelStatus
$cmaxBound :: OtelStatus
maxBound :: OtelStatus
Bounded, Int -> OtelStatus
OtelStatus -> Int
OtelStatus -> [OtelStatus]
OtelStatus -> OtelStatus
OtelStatus -> OtelStatus -> [OtelStatus]
OtelStatus -> OtelStatus -> OtelStatus -> [OtelStatus]
(OtelStatus -> OtelStatus)
-> (OtelStatus -> OtelStatus)
-> (Int -> OtelStatus)
-> (OtelStatus -> Int)
-> (OtelStatus -> [OtelStatus])
-> (OtelStatus -> OtelStatus -> [OtelStatus])
-> (OtelStatus -> OtelStatus -> [OtelStatus])
-> (OtelStatus -> OtelStatus -> OtelStatus -> [OtelStatus])
-> Enum OtelStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OtelStatus -> OtelStatus
succ :: OtelStatus -> OtelStatus
$cpred :: OtelStatus -> OtelStatus
pred :: OtelStatus -> OtelStatus
$ctoEnum :: Int -> OtelStatus
toEnum :: Int -> OtelStatus
$cfromEnum :: OtelStatus -> Int
fromEnum :: OtelStatus -> Int
$cenumFrom :: OtelStatus -> [OtelStatus]
enumFrom :: OtelStatus -> [OtelStatus]
$cenumFromThen :: OtelStatus -> OtelStatus -> [OtelStatus]
enumFromThen :: OtelStatus -> OtelStatus -> [OtelStatus]
$cenumFromTo :: OtelStatus -> OtelStatus -> [OtelStatus]
enumFromTo :: OtelStatus -> OtelStatus -> [OtelStatus]
$cenumFromThenTo :: OtelStatus -> OtelStatus -> OtelStatus -> [OtelStatus]
enumFromThenTo :: OtelStatus -> OtelStatus -> OtelStatus -> [OtelStatus]
Enum)

defaultOtelStatus :: OtelStatus
defaultOtelStatus :: OtelStatus
defaultOtelStatus = OtelStatus
OtelDisabled

instance HasCodec OtelStatus where
  codec :: JSONCodec OtelStatus
codec = (OtelStatus -> String) -> JSONCodec OtelStatus
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> String) -> JSONCodec enum
boundedEnumCodec \case
    OtelStatus
OtelEnabled -> String
"enabled"
    OtelStatus
OtelDisabled -> String
"disabled"

instance FromJSON OtelStatus where
  parseJSON :: Value -> Parser OtelStatus
parseJSON = \case
    J.String Text
s
      | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"enabled" -> OtelStatus -> Parser OtelStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OtelStatus
OtelEnabled
      | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"disabled" -> OtelStatus -> Parser OtelStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OtelStatus
OtelDisabled
    Value
_ -> String -> Parser OtelStatus
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"OpenTelemetry status must be either \"enabled\" or \"disabled\""

instance ToJSON OtelStatus where
  toJSON :: OtelStatus -> Value
toJSON OtelStatus
status =
    Text -> Value
J.String
      (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case OtelStatus
status of
        OtelStatus
OtelEnabled -> Text
"enabled"
        OtelStatus
OtelDisabled -> Text
"disabled"

-- We currently only support traces
data OtelDataType
  = OtelTraces
  deriving stock (OtelDataType -> OtelDataType -> Bool
(OtelDataType -> OtelDataType -> Bool)
-> (OtelDataType -> OtelDataType -> Bool) -> Eq OtelDataType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OtelDataType -> OtelDataType -> Bool
== :: OtelDataType -> OtelDataType -> Bool
$c/= :: OtelDataType -> OtelDataType -> Bool
/= :: OtelDataType -> OtelDataType -> Bool
Eq, Eq OtelDataType
Eq OtelDataType
-> (OtelDataType -> OtelDataType -> Ordering)
-> (OtelDataType -> OtelDataType -> Bool)
-> (OtelDataType -> OtelDataType -> Bool)
-> (OtelDataType -> OtelDataType -> Bool)
-> (OtelDataType -> OtelDataType -> Bool)
-> (OtelDataType -> OtelDataType -> OtelDataType)
-> (OtelDataType -> OtelDataType -> OtelDataType)
-> Ord OtelDataType
OtelDataType -> OtelDataType -> Bool
OtelDataType -> OtelDataType -> Ordering
OtelDataType -> OtelDataType -> OtelDataType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OtelDataType -> OtelDataType -> Ordering
compare :: OtelDataType -> OtelDataType -> Ordering
$c< :: OtelDataType -> OtelDataType -> Bool
< :: OtelDataType -> OtelDataType -> Bool
$c<= :: OtelDataType -> OtelDataType -> Bool
<= :: OtelDataType -> OtelDataType -> Bool
$c> :: OtelDataType -> OtelDataType -> Bool
> :: OtelDataType -> OtelDataType -> Bool
$c>= :: OtelDataType -> OtelDataType -> Bool
>= :: OtelDataType -> OtelDataType -> Bool
$cmax :: OtelDataType -> OtelDataType -> OtelDataType
max :: OtelDataType -> OtelDataType -> OtelDataType
$cmin :: OtelDataType -> OtelDataType -> OtelDataType
min :: OtelDataType -> OtelDataType -> OtelDataType
Ord, Int -> OtelDataType -> ShowS
[OtelDataType] -> ShowS
OtelDataType -> String
(Int -> OtelDataType -> ShowS)
-> (OtelDataType -> String)
-> ([OtelDataType] -> ShowS)
-> Show OtelDataType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OtelDataType -> ShowS
showsPrec :: Int -> OtelDataType -> ShowS
$cshow :: OtelDataType -> String
show :: OtelDataType -> String
$cshowList :: [OtelDataType] -> ShowS
showList :: [OtelDataType] -> ShowS
Show, OtelDataType
OtelDataType -> OtelDataType -> Bounded OtelDataType
forall a. a -> a -> Bounded a
$cminBound :: OtelDataType
minBound :: OtelDataType
$cmaxBound :: OtelDataType
maxBound :: OtelDataType
Bounded, Int -> OtelDataType
OtelDataType -> Int
OtelDataType -> [OtelDataType]
OtelDataType -> OtelDataType
OtelDataType -> OtelDataType -> [OtelDataType]
OtelDataType -> OtelDataType -> OtelDataType -> [OtelDataType]
(OtelDataType -> OtelDataType)
-> (OtelDataType -> OtelDataType)
-> (Int -> OtelDataType)
-> (OtelDataType -> Int)
-> (OtelDataType -> [OtelDataType])
-> (OtelDataType -> OtelDataType -> [OtelDataType])
-> (OtelDataType -> OtelDataType -> [OtelDataType])
-> (OtelDataType -> OtelDataType -> OtelDataType -> [OtelDataType])
-> Enum OtelDataType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OtelDataType -> OtelDataType
succ :: OtelDataType -> OtelDataType
$cpred :: OtelDataType -> OtelDataType
pred :: OtelDataType -> OtelDataType
$ctoEnum :: Int -> OtelDataType
toEnum :: Int -> OtelDataType
$cfromEnum :: OtelDataType -> Int
fromEnum :: OtelDataType -> Int
$cenumFrom :: OtelDataType -> [OtelDataType]
enumFrom :: OtelDataType -> [OtelDataType]
$cenumFromThen :: OtelDataType -> OtelDataType -> [OtelDataType]
enumFromThen :: OtelDataType -> OtelDataType -> [OtelDataType]
$cenumFromTo :: OtelDataType -> OtelDataType -> [OtelDataType]
enumFromTo :: OtelDataType -> OtelDataType -> [OtelDataType]
$cenumFromThenTo :: OtelDataType -> OtelDataType -> OtelDataType -> [OtelDataType]
enumFromThenTo :: OtelDataType -> OtelDataType -> OtelDataType -> [OtelDataType]
Enum)

instance HasCodec OtelDataType where
  codec :: JSONCodec OtelDataType
codec = (OtelDataType -> String) -> JSONCodec OtelDataType
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> String) -> JSONCodec enum
boundedEnumCodec \case
    OtelDataType
OtelTraces -> String
"traces"

instance FromJSON OtelDataType where
  parseJSON :: Value -> Parser OtelDataType
parseJSON = String
-> (Text -> Parser OtelDataType) -> Value -> Parser OtelDataType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"OtelDataType" \case
    Text
"traces" -> OtelDataType -> Parser OtelDataType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OtelDataType
OtelTraces
    Text
x -> String -> Parser OtelDataType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser OtelDataType) -> String -> Parser OtelDataType
forall a b. (a -> b) -> a -> b
$ String
"unexpected string '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'."

instance ToJSON OtelDataType where
  toJSON :: OtelDataType -> Value
toJSON = \case
    OtelDataType
OtelTraces -> Text -> Value
J.String Text
"traces"

defaultOtelEnabledDataTypes :: Set OtelDataType
defaultOtelEnabledDataTypes :: Set OtelDataType
defaultOtelEnabledDataTypes = Set OtelDataType
forall a. Set a
Set.empty

-- | https://opentelemetry.io/docs/reference/specification/protocol/exporter/
data OtelExporterConfig = OtelExporterConfig
  { -- | Target URL to which the exporter is going to send traces. No default.
    OtelExporterConfig -> Maybe Text
_oecTracesEndpoint :: Maybe Text,
    -- | The transport protocol
    OtelExporterConfig -> OtlpProtocol
_oecProtocol :: OtlpProtocol,
    -- | Key-value pairs to be used as headers to send with an export request.
    OtelExporterConfig -> [HeaderConf]
_oecHeaders :: [HeaderConf],
    -- | Attributes to send as the resource attributes of an export request. We
    -- currently only support string-valued attributes.
    OtelExporterConfig -> [NameValue]
_oecResourceAttributes :: [NameValue]
  }
  deriving stock (OtelExporterConfig -> OtelExporterConfig -> Bool
(OtelExporterConfig -> OtelExporterConfig -> Bool)
-> (OtelExporterConfig -> OtelExporterConfig -> Bool)
-> Eq OtelExporterConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OtelExporterConfig -> OtelExporterConfig -> Bool
== :: OtelExporterConfig -> OtelExporterConfig -> Bool
$c/= :: OtelExporterConfig -> OtelExporterConfig -> Bool
/= :: OtelExporterConfig -> OtelExporterConfig -> Bool
Eq, Int -> OtelExporterConfig -> ShowS
[OtelExporterConfig] -> ShowS
OtelExporterConfig -> String
(Int -> OtelExporterConfig -> ShowS)
-> (OtelExporterConfig -> String)
-> ([OtelExporterConfig] -> ShowS)
-> Show OtelExporterConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OtelExporterConfig -> ShowS
showsPrec :: Int -> OtelExporterConfig -> ShowS
$cshow :: OtelExporterConfig -> String
show :: OtelExporterConfig -> String
$cshowList :: [OtelExporterConfig] -> ShowS
showList :: [OtelExporterConfig] -> ShowS
Show)

instance HasCodec OtelExporterConfig where
  codec :: JSONCodec OtelExporterConfig
codec =
    Text
-> ObjectCodec OtelExporterConfig OtelExporterConfig
-> JSONCodec OtelExporterConfig
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"OtelExporterConfig"
      (ObjectCodec OtelExporterConfig OtelExporterConfig
 -> JSONCodec OtelExporterConfig)
-> ObjectCodec OtelExporterConfig OtelExporterConfig
-> JSONCodec OtelExporterConfig
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> OtlpProtocol
-> [HeaderConf]
-> [NameValue]
-> OtelExporterConfig
OtelExporterConfig
      (Maybe Text
 -> OtlpProtocol
 -> [HeaderConf]
 -> [NameValue]
 -> OtelExporterConfig)
-> Codec Object OtelExporterConfig (Maybe Text)
-> Codec
     Object
     OtelExporterConfig
     (OtlpProtocol -> [HeaderConf] -> [NameValue] -> OtelExporterConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"otlp_traces_endpoint" Text
tracesEndpointDoc
      ObjectCodec (Maybe Text) (Maybe Text)
-> (OtelExporterConfig -> Maybe Text)
-> Codec Object OtelExporterConfig (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OtelExporterConfig -> Maybe Text
_oecTracesEndpoint
        Codec
  Object
  OtelExporterConfig
  (OtlpProtocol -> [HeaderConf] -> [NameValue] -> OtelExporterConfig)
-> Codec Object OtelExporterConfig OtlpProtocol
-> Codec
     Object
     OtelExporterConfig
     ([HeaderConf] -> [NameValue] -> OtelExporterConfig)
forall a b.
Codec Object OtelExporterConfig (a -> b)
-> Codec Object OtelExporterConfig a
-> Codec Object OtelExporterConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> OtlpProtocol -> Text -> ObjectCodec OtlpProtocol OtlpProtocol
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithDefault Text
"protocol" OtlpProtocol
defaultOtelExporterProtocol Text
protocolDoc
      ObjectCodec OtlpProtocol OtlpProtocol
-> (OtelExporterConfig -> OtlpProtocol)
-> Codec Object OtelExporterConfig OtlpProtocol
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OtelExporterConfig -> OtlpProtocol
_oecProtocol
        Codec
  Object
  OtelExporterConfig
  ([HeaderConf] -> [NameValue] -> OtelExporterConfig)
-> Codec Object OtelExporterConfig [HeaderConf]
-> Codec
     Object OtelExporterConfig ([NameValue] -> OtelExporterConfig)
forall a b.
Codec Object OtelExporterConfig (a -> b)
-> Codec Object OtelExporterConfig a
-> Codec Object OtelExporterConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> [HeaderConf] -> Text -> ObjectCodec [HeaderConf] [HeaderConf]
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithDefault Text
"headers" [HeaderConf]
defaultOtelExporterHeaders Text
headersDoc
      ObjectCodec [HeaderConf] [HeaderConf]
-> (OtelExporterConfig -> [HeaderConf])
-> Codec Object OtelExporterConfig [HeaderConf]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OtelExporterConfig -> [HeaderConf]
_oecHeaders
        Codec Object OtelExporterConfig ([NameValue] -> OtelExporterConfig)
-> Codec Object OtelExporterConfig [NameValue]
-> ObjectCodec OtelExporterConfig OtelExporterConfig
forall a b.
Codec Object OtelExporterConfig (a -> b)
-> Codec Object OtelExporterConfig a
-> Codec Object OtelExporterConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> [NameValue] -> Text -> ObjectCodec [NameValue] [NameValue]
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithDefault Text
"resource_attributes" [NameValue]
defaultOtelExporterResourceAttributes Text
attrsDoc
      ObjectCodec [NameValue] [NameValue]
-> (OtelExporterConfig -> [NameValue])
-> Codec Object OtelExporterConfig [NameValue]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OtelExporterConfig -> [NameValue]
_oecResourceAttributes
    where
      tracesEndpointDoc :: Text
tracesEndpointDoc = Text
"Target URL to which the exporter is going to send traces. No default."
      protocolDoc :: Text
protocolDoc = Text
"The transport protocol"
      headersDoc :: Text
headersDoc = Text
"Key-value pairs to be used as headers to send with an export request."
      attrsDoc :: Text
attrsDoc = Text
"Attributes to send as the resource attributes of an export request. We currently only support string-valued attributes."

instance FromJSON OtelExporterConfig where
  parseJSON :: Value -> Parser OtelExporterConfig
parseJSON = String
-> (Object -> Parser OtelExporterConfig)
-> Value
-> Parser OtelExporterConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"OtelExporterConfig" ((Object -> Parser OtelExporterConfig)
 -> Value -> Parser OtelExporterConfig)
-> (Object -> Parser OtelExporterConfig)
-> Value
-> Parser OtelExporterConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe Text
_oecTracesEndpoint <-
      Object
o Object -> Key -> Parser (Maybe (Maybe Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"otlp_traces_endpoint" Parser (Maybe (Maybe Text)) -> Maybe Text -> Parser (Maybe Text)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe Text
defaultOtelExporterTracesEndpoint
    OtlpProtocol
_oecProtocol <-
      Object
o Object -> Key -> Parser (Maybe OtlpProtocol)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protocol" Parser (Maybe OtlpProtocol) -> OtlpProtocol -> Parser OtlpProtocol
forall a. Parser (Maybe a) -> a -> Parser a
.!= OtlpProtocol
defaultOtelExporterProtocol
    [HeaderConf]
_oecHeaders <-
      Object
o Object -> Key -> Parser (Maybe [HeaderConf])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" Parser (Maybe [HeaderConf]) -> [HeaderConf] -> Parser [HeaderConf]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [HeaderConf]
defaultOtelExporterHeaders
    [NameValue]
_oecResourceAttributes <-
      Object
o Object -> Key -> Parser (Maybe [NameValue])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resource_attributes" Parser (Maybe [NameValue]) -> [NameValue] -> Parser [NameValue]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [NameValue]
defaultOtelExporterResourceAttributes
    OtelExporterConfig -> Parser OtelExporterConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OtelExporterConfig {[HeaderConf]
[NameValue]
Maybe Text
OtlpProtocol
_oecTracesEndpoint :: Maybe Text
_oecProtocol :: OtlpProtocol
_oecHeaders :: [HeaderConf]
_oecResourceAttributes :: [NameValue]
_oecTracesEndpoint :: Maybe Text
_oecProtocol :: OtlpProtocol
_oecHeaders :: [HeaderConf]
_oecResourceAttributes :: [NameValue]
..}

instance ToJSON OtelExporterConfig where
  toJSON :: OtelExporterConfig -> Value
toJSON (OtelExporterConfig Maybe Text
otlpTracesEndpoint OtlpProtocol
protocol [HeaderConf]
headers [NameValue]
resourceAttributes) =
    [Pair] -> Value
J.object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
        [ (Key
"otlp_traces_endpoint" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
otlpTracesEndpoint,
          Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"protocol" Key -> OtlpProtocol -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= OtlpProtocol
protocol,
          Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"headers" Key -> [HeaderConf] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [HeaderConf]
headers,
          Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"resource_attributes" Key -> [NameValue] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [NameValue]
resourceAttributes
        ]

defaultOtelExporterConfig :: OtelExporterConfig
defaultOtelExporterConfig :: OtelExporterConfig
defaultOtelExporterConfig =
  OtelExporterConfig
    { _oecTracesEndpoint :: Maybe Text
_oecTracesEndpoint = Maybe Text
defaultOtelExporterTracesEndpoint,
      _oecProtocol :: OtlpProtocol
_oecProtocol = OtlpProtocol
defaultOtelExporterProtocol,
      _oecHeaders :: [HeaderConf]
_oecHeaders = [HeaderConf]
defaultOtelExporterHeaders,
      _oecResourceAttributes :: [NameValue]
_oecResourceAttributes = [NameValue]
defaultOtelExporterResourceAttributes
    }

-- | Possible protocol to use with OTLP. Currently, only http/protobuf is
-- supported.
data OtlpProtocol
  = OtlpProtocolHttpProtobuf
  -- OtlpProtocolHttpJson
  -- OtlpProtocolGrpc
  deriving stock (OtlpProtocol -> OtlpProtocol -> Bool
(OtlpProtocol -> OtlpProtocol -> Bool)
-> (OtlpProtocol -> OtlpProtocol -> Bool) -> Eq OtlpProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OtlpProtocol -> OtlpProtocol -> Bool
== :: OtlpProtocol -> OtlpProtocol -> Bool
$c/= :: OtlpProtocol -> OtlpProtocol -> Bool
/= :: OtlpProtocol -> OtlpProtocol -> Bool
Eq, Int -> OtlpProtocol -> ShowS
[OtlpProtocol] -> ShowS
OtlpProtocol -> String
(Int -> OtlpProtocol -> ShowS)
-> (OtlpProtocol -> String)
-> ([OtlpProtocol] -> ShowS)
-> Show OtlpProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OtlpProtocol -> ShowS
showsPrec :: Int -> OtlpProtocol -> ShowS
$cshow :: OtlpProtocol -> String
show :: OtlpProtocol -> String
$cshowList :: [OtlpProtocol] -> ShowS
showList :: [OtlpProtocol] -> ShowS
Show, OtlpProtocol
OtlpProtocol -> OtlpProtocol -> Bounded OtlpProtocol
forall a. a -> a -> Bounded a
$cminBound :: OtlpProtocol
minBound :: OtlpProtocol
$cmaxBound :: OtlpProtocol
maxBound :: OtlpProtocol
Bounded, Int -> OtlpProtocol
OtlpProtocol -> Int
OtlpProtocol -> [OtlpProtocol]
OtlpProtocol -> OtlpProtocol
OtlpProtocol -> OtlpProtocol -> [OtlpProtocol]
OtlpProtocol -> OtlpProtocol -> OtlpProtocol -> [OtlpProtocol]
(OtlpProtocol -> OtlpProtocol)
-> (OtlpProtocol -> OtlpProtocol)
-> (Int -> OtlpProtocol)
-> (OtlpProtocol -> Int)
-> (OtlpProtocol -> [OtlpProtocol])
-> (OtlpProtocol -> OtlpProtocol -> [OtlpProtocol])
-> (OtlpProtocol -> OtlpProtocol -> [OtlpProtocol])
-> (OtlpProtocol -> OtlpProtocol -> OtlpProtocol -> [OtlpProtocol])
-> Enum OtlpProtocol
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OtlpProtocol -> OtlpProtocol
succ :: OtlpProtocol -> OtlpProtocol
$cpred :: OtlpProtocol -> OtlpProtocol
pred :: OtlpProtocol -> OtlpProtocol
$ctoEnum :: Int -> OtlpProtocol
toEnum :: Int -> OtlpProtocol
$cfromEnum :: OtlpProtocol -> Int
fromEnum :: OtlpProtocol -> Int
$cenumFrom :: OtlpProtocol -> [OtlpProtocol]
enumFrom :: OtlpProtocol -> [OtlpProtocol]
$cenumFromThen :: OtlpProtocol -> OtlpProtocol -> [OtlpProtocol]
enumFromThen :: OtlpProtocol -> OtlpProtocol -> [OtlpProtocol]
$cenumFromTo :: OtlpProtocol -> OtlpProtocol -> [OtlpProtocol]
enumFromTo :: OtlpProtocol -> OtlpProtocol -> [OtlpProtocol]
$cenumFromThenTo :: OtlpProtocol -> OtlpProtocol -> OtlpProtocol -> [OtlpProtocol]
enumFromThenTo :: OtlpProtocol -> OtlpProtocol -> OtlpProtocol -> [OtlpProtocol]
Enum)

instance HasCodec OtlpProtocol where
  codec :: JSONCodec OtlpProtocol
codec =
    ( (OtlpProtocol -> String) -> JSONCodec OtlpProtocol
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> String) -> JSONCodec enum
boundedEnumCodec \case
        OtlpProtocol
OtlpProtocolHttpProtobuf -> String
"http/protobuf"
    )
      JSONCodec OtlpProtocol -> Text -> JSONCodec OtlpProtocol
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"Possible protocol to use with OTLP. Currently, only http/protobuf is supported."

instance FromJSON OtlpProtocol where
  parseJSON :: Value -> Parser OtlpProtocol
parseJSON = String
-> (Text -> Parser OtlpProtocol) -> Value -> Parser OtlpProtocol
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"OtlpProtocol" \case
    Text
"http/protobuf" -> OtlpProtocol -> Parser OtlpProtocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OtlpProtocol
OtlpProtocolHttpProtobuf
    Text
"http/json" -> String -> Parser OtlpProtocol
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"http/json is not supported"
    Text
"grpc" -> String -> Parser OtlpProtocol
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"gRPC is not supported"
    Text
x -> String -> Parser OtlpProtocol
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser OtlpProtocol) -> String -> Parser OtlpProtocol
forall a b. (a -> b) -> a -> b
$ String
"unexpected string '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'."

instance ToJSON OtlpProtocol where
  toJSON :: OtlpProtocol -> Value
toJSON = \case
    OtlpProtocol
OtlpProtocolHttpProtobuf -> Text -> Value
J.String Text
"http/protobuf"

-- Internal helper type for JSON lists of key-value pairs
data NameValue = NameValue
  { NameValue -> Text
nv_name :: Text,
    NameValue -> Text
nv_value :: Text
  }
  deriving stock (NameValue -> NameValue -> Bool
(NameValue -> NameValue -> Bool)
-> (NameValue -> NameValue -> Bool) -> Eq NameValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameValue -> NameValue -> Bool
== :: NameValue -> NameValue -> Bool
$c/= :: NameValue -> NameValue -> Bool
/= :: NameValue -> NameValue -> Bool
Eq, Int -> NameValue -> ShowS
[NameValue] -> ShowS
NameValue -> String
(Int -> NameValue -> ShowS)
-> (NameValue -> String)
-> ([NameValue] -> ShowS)
-> Show NameValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameValue -> ShowS
showsPrec :: Int -> NameValue -> ShowS
$cshow :: NameValue -> String
show :: NameValue -> String
$cshowList :: [NameValue] -> ShowS
showList :: [NameValue] -> ShowS
Show)

instance HasCodec NameValue where
  codec :: JSONCodec NameValue
codec =
    Text -> ObjectCodec NameValue NameValue -> JSONCodec NameValue
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object
      Text
"OtelNameValue"
      ( Text -> Text -> NameValue
NameValue
          (Text -> Text -> NameValue)
-> Codec Object NameValue Text
-> Codec Object NameValue (Text -> NameValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
          ObjectCodec Text Text
-> (NameValue -> Text) -> Codec Object NameValue Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= NameValue -> Text
nv_name
            Codec Object NameValue (Text -> NameValue)
-> Codec Object NameValue Text -> ObjectCodec NameValue NameValue
forall a b.
Codec Object NameValue (a -> b)
-> Codec Object NameValue a -> Codec Object NameValue b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"value"
          ObjectCodec Text Text
-> (NameValue -> Text) -> Codec Object NameValue Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= NameValue -> Text
nv_value
      )
      JSONCodec NameValue -> Text -> JSONCodec NameValue
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"Internal helper type for JSON lists of key-value pairs"

instance ToJSON NameValue where
  toJSON :: NameValue -> Value
toJSON (NameValue {Text
nv_name :: NameValue -> Text
nv_name :: Text
nv_name, Text
nv_value :: NameValue -> Text
nv_value :: Text
nv_value}) =
    [Pair] -> Value
J.object [Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
nv_name, Key
"value" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
nv_value]

instance FromJSON NameValue where
  parseJSON :: Value -> Parser NameValue
parseJSON = String -> (Object -> Parser NameValue) -> Value -> Parser NameValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"name-value pair" ((Object -> Parser NameValue) -> Value -> Parser NameValue)
-> (Object -> Parser NameValue) -> Value -> Parser NameValue
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
nv_name <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Text
nv_value <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
    NameValue -> Parser NameValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameValue {Text
nv_name :: Text
nv_value :: Text
nv_name :: Text
nv_value :: Text
..}

defaultOtelExporterTracesEndpoint :: Maybe Text
defaultOtelExporterTracesEndpoint :: Maybe Text
defaultOtelExporterTracesEndpoint = Maybe Text
forall a. Maybe a
Nothing

defaultOtelExporterProtocol :: OtlpProtocol
defaultOtelExporterProtocol :: OtlpProtocol
defaultOtelExporterProtocol = OtlpProtocol
OtlpProtocolHttpProtobuf

defaultOtelExporterHeaders :: [HeaderConf]
defaultOtelExporterHeaders :: [HeaderConf]
defaultOtelExporterHeaders = []

defaultOtelExporterResourceAttributes :: [NameValue]
defaultOtelExporterResourceAttributes :: [NameValue]
defaultOtelExporterResourceAttributes = []

-- https://github.com/open-telemetry/opentelemetry-specification/blob/main/specification/trace/sdk.md#batching-processor
newtype OtelBatchSpanProcessorConfig = OtelBatchSpanProcessorConfig
  { -- | The maximum batch size of every export. It must be smaller or equal to
    -- maxQueueSize (not yet configurable). Default 512.
    OtelBatchSpanProcessorConfig -> Int
_obspcMaxExportBatchSize :: Int
  }
  deriving stock (OtelBatchSpanProcessorConfig
-> OtelBatchSpanProcessorConfig -> Bool
(OtelBatchSpanProcessorConfig
 -> OtelBatchSpanProcessorConfig -> Bool)
-> (OtelBatchSpanProcessorConfig
    -> OtelBatchSpanProcessorConfig -> Bool)
-> Eq OtelBatchSpanProcessorConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OtelBatchSpanProcessorConfig
-> OtelBatchSpanProcessorConfig -> Bool
== :: OtelBatchSpanProcessorConfig
-> OtelBatchSpanProcessorConfig -> Bool
$c/= :: OtelBatchSpanProcessorConfig
-> OtelBatchSpanProcessorConfig -> Bool
/= :: OtelBatchSpanProcessorConfig
-> OtelBatchSpanProcessorConfig -> Bool
Eq, Int -> OtelBatchSpanProcessorConfig -> ShowS
[OtelBatchSpanProcessorConfig] -> ShowS
OtelBatchSpanProcessorConfig -> String
(Int -> OtelBatchSpanProcessorConfig -> ShowS)
-> (OtelBatchSpanProcessorConfig -> String)
-> ([OtelBatchSpanProcessorConfig] -> ShowS)
-> Show OtelBatchSpanProcessorConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OtelBatchSpanProcessorConfig -> ShowS
showsPrec :: Int -> OtelBatchSpanProcessorConfig -> ShowS
$cshow :: OtelBatchSpanProcessorConfig -> String
show :: OtelBatchSpanProcessorConfig -> String
$cshowList :: [OtelBatchSpanProcessorConfig] -> ShowS
showList :: [OtelBatchSpanProcessorConfig] -> ShowS
Show)

instance HasCodec OtelBatchSpanProcessorConfig where
  codec :: JSONCodec OtelBatchSpanProcessorConfig
codec =
    Text
-> ObjectCodec
     OtelBatchSpanProcessorConfig OtelBatchSpanProcessorConfig
-> JSONCodec OtelBatchSpanProcessorConfig
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"OtelBatchSpanProcessorConfig"
      (ObjectCodec
   OtelBatchSpanProcessorConfig OtelBatchSpanProcessorConfig
 -> JSONCodec OtelBatchSpanProcessorConfig)
-> ObjectCodec
     OtelBatchSpanProcessorConfig OtelBatchSpanProcessorConfig
-> JSONCodec OtelBatchSpanProcessorConfig
forall a b. (a -> b) -> a -> b
$ Int -> OtelBatchSpanProcessorConfig
OtelBatchSpanProcessorConfig
      (Int -> OtelBatchSpanProcessorConfig)
-> Codec Object OtelBatchSpanProcessorConfig Int
-> ObjectCodec
     OtelBatchSpanProcessorConfig OtelBatchSpanProcessorConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Int -> Text -> ObjectCodec Int Int
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithDefault Text
"max_export_batch_size" Int
defaultMaxExportBatchSize Text
maxSizeDoc
      ObjectCodec Int Int
-> (OtelBatchSpanProcessorConfig -> Int)
-> Codec Object OtelBatchSpanProcessorConfig Int
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= OtelBatchSpanProcessorConfig -> Int
_obspcMaxExportBatchSize
    where
      maxSizeDoc :: Text
maxSizeDoc = Text
"The maximum batch size of every export. It must be smaller or equal to maxQueueSize (not yet configurable). Default 512."

instance FromJSON OtelBatchSpanProcessorConfig where
  parseJSON :: Value -> Parser OtelBatchSpanProcessorConfig
parseJSON = String
-> (Object -> Parser OtelBatchSpanProcessorConfig)
-> Value
-> Parser OtelBatchSpanProcessorConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"OtelBatchSpanProcessorConfig" ((Object -> Parser OtelBatchSpanProcessorConfig)
 -> Value -> Parser OtelBatchSpanProcessorConfig)
-> (Object -> Parser OtelBatchSpanProcessorConfig)
-> Value
-> Parser OtelBatchSpanProcessorConfig
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Int -> OtelBatchSpanProcessorConfig
OtelBatchSpanProcessorConfig
      (Int -> OtelBatchSpanProcessorConfig)
-> Parser Int -> Parser OtelBatchSpanProcessorConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_export_batch_size"
      Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
defaultMaxExportBatchSize

instance ToJSON OtelBatchSpanProcessorConfig where
  toJSON :: OtelBatchSpanProcessorConfig -> Value
toJSON (OtelBatchSpanProcessorConfig Int
maxExportBatchSize) =
    [Pair] -> Value
J.object
      [ Key
"max_export_batch_size" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int
maxExportBatchSize
      ]

defaultOtelBatchSpanProcessorConfig :: OtelBatchSpanProcessorConfig
defaultOtelBatchSpanProcessorConfig :: OtelBatchSpanProcessorConfig
defaultOtelBatchSpanProcessorConfig =
  OtelBatchSpanProcessorConfig
    { _obspcMaxExportBatchSize :: Int
_obspcMaxExportBatchSize = Int
defaultMaxExportBatchSize
    }

defaultMaxExportBatchSize :: Int
defaultMaxExportBatchSize :: Int
defaultMaxExportBatchSize = Int
512

$(makeLenses ''OpenTelemetryConfig)

--------------------------------------------------------------------------------

-- * Parsed configuration (schema cache)

-- | Schema cache configuration for all OpenTelemetry-related features
data OpenTelemetryInfo = OpenTelemetryInfo
  { OpenTelemetryInfo -> Maybe OtelExporterInfo
_otiExporterOtlp :: Maybe OtelExporterInfo,
    -- | A value of 'Nothing' indicates that the export of trace data is
    -- disabled.
    OpenTelemetryInfo -> Maybe OtelBatchSpanProcessorInfo
_otiBatchSpanProcessor :: Maybe OtelBatchSpanProcessorInfo
  }

emptyOpenTelemetryInfo :: OpenTelemetryInfo
emptyOpenTelemetryInfo :: OpenTelemetryInfo
emptyOpenTelemetryInfo =
  OpenTelemetryInfo
    { _otiExporterOtlp :: Maybe OtelExporterInfo
_otiExporterOtlp = Maybe OtelExporterInfo
forall a. Maybe a
Nothing,
      _otiBatchSpanProcessor :: Maybe OtelBatchSpanProcessorInfo
_otiBatchSpanProcessor = Maybe OtelBatchSpanProcessorInfo
forall a. Maybe a
Nothing
    }

data OtelExporterInfo = OtelExporterInfo
  { -- | HTTP 'Request' containing (1) the target URL to which the exporter is
    -- going to send spans, and (2) the user-specified request headers.
    OtelExporterInfo -> Request
_oteleiTracesBaseRequest :: Request,
    -- | Attributes to send as the resource attributes of an export request. We
    -- currently only support string-valued attributes.
    --
    -- Using Data.Map.Strict over Data.Hashmap.Strict because currently the
    -- only operations on data are (1) folding and (2) union with a small
    -- map of default attributes, and Map should be is faster than HashMap for
    -- the latter.
    OtelExporterInfo -> Map Text Text
_oteleiResourceAttributes :: Map Text Text
  }

getOtelExporterTracesBaseRequest :: OtelExporterInfo -> Request
getOtelExporterTracesBaseRequest :: OtelExporterInfo -> Request
getOtelExporterTracesBaseRequest = OtelExporterInfo -> Request
_oteleiTracesBaseRequest

getOtelExporterResourceAttributes :: OtelExporterInfo -> Map Text Text
getOtelExporterResourceAttributes :: OtelExporterInfo -> Map Text Text
getOtelExporterResourceAttributes = OtelExporterInfo -> Map Text Text
_oteleiResourceAttributes

data OtelBatchSpanProcessorInfo = OtelBatchSpanProcessorInfo
  { -- | The maximum batch size of every export. It must be smaller or equal to
    -- maxQueueSize. Default 512.
    OtelBatchSpanProcessorInfo -> Int
_obspiMaxExportBatchSize :: Int,
    -- | The maximum span queue size. After the size is reached spans are
    -- dropped. Default 2048.
    OtelBatchSpanProcessorInfo -> Int
_obspiMaxQueueSize :: Int
  }
  deriving ((forall (m :: * -> *).
 Quote m =>
 OtelBatchSpanProcessorInfo -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    OtelBatchSpanProcessorInfo -> Code m OtelBatchSpanProcessorInfo)
-> Lift OtelBatchSpanProcessorInfo
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *).
Quote m =>
OtelBatchSpanProcessorInfo -> m Exp
forall (m :: * -> *).
Quote m =>
OtelBatchSpanProcessorInfo -> Code m OtelBatchSpanProcessorInfo
$clift :: forall (m :: * -> *).
Quote m =>
OtelBatchSpanProcessorInfo -> m Exp
lift :: forall (m :: * -> *).
Quote m =>
OtelBatchSpanProcessorInfo -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
OtelBatchSpanProcessorInfo -> Code m OtelBatchSpanProcessorInfo
liftTyped :: forall (m :: * -> *).
Quote m =>
OtelBatchSpanProcessorInfo -> Code m OtelBatchSpanProcessorInfo
Lift)

getMaxExportBatchSize :: OtelBatchSpanProcessorInfo -> Int
getMaxExportBatchSize :: OtelBatchSpanProcessorInfo -> Int
getMaxExportBatchSize = OtelBatchSpanProcessorInfo -> Int
_obspiMaxExportBatchSize

getMaxQueueSize :: OtelBatchSpanProcessorInfo -> Int
getMaxQueueSize :: OtelBatchSpanProcessorInfo -> Int
getMaxQueueSize = OtelBatchSpanProcessorInfo -> Int
_obspiMaxQueueSize

-- | Defaults taken from
-- https://github.com/open-telemetry/opentelemetry-specification/blob/main/specification/trace/sdk.md#batching-processor
defaultOtelBatchSpanProcessorInfo :: OtelBatchSpanProcessorInfo
defaultOtelBatchSpanProcessorInfo :: OtelBatchSpanProcessorInfo
defaultOtelBatchSpanProcessorInfo =
  OtelBatchSpanProcessorInfo
    { _obspiMaxExportBatchSize :: Int
_obspiMaxExportBatchSize = Int
512,
      _obspiMaxQueueSize :: Int
_obspiMaxQueueSize = Int
2048
    }

$(makeLenses ''OpenTelemetryInfo)