module Hasura.RQL.DDL.OpenTelemetry
  ( runSetOpenTelemetryConfig,
    runSetOpenTelemetryStatus,
    parseOtelExporterConfig,
    parseOtelBatchSpanProcessorConfig,
  )
where

import Control.Lens ((.~))
import Data.Bifunctor (first)
import Data.Environment (Environment)
import Data.Map.Strict qualified as Map
import Data.Text qualified as Text
import Hasura.Base.Error (Code (InvalidParams), QErr, err400)
import Hasura.EncJSON
import Hasura.Metadata.Class ()
import Hasura.Prelude hiding (first)
import Hasura.RQL.DDL.Headers (makeHeadersFromConf)
import Hasura.RQL.Types.Common (successMsg)
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.OpenTelemetry
import Hasura.RQL.Types.SchemaCache.Build
import Network.HTTP.Client (Request (requestHeaders), requestFromURI)
import Network.URI (parseURI)

-- | Set the OpenTelemetry configuration to the provided value.
runSetOpenTelemetryConfig ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  OpenTelemetryConfig ->
  m EncJSON
runSetOpenTelemetryConfig :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m, CacheRWM m) =>
OpenTelemetryConfig -> m EncJSON
runSetOpenTelemetryConfig OpenTelemetryConfig
otelConfig = do
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (OpenTelemetryConfigSubobject -> MetadataObjId
MOOpenTelemetry OpenTelemetryConfigSubobject
OtelSubobjectAll)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (OpenTelemetryConfig -> Identity OpenTelemetryConfig)
-> Metadata -> Identity Metadata
Lens' Metadata OpenTelemetryConfig
metaOpenTelemetryConfig
    ((OpenTelemetryConfig -> Identity OpenTelemetryConfig)
 -> Metadata -> Identity Metadata)
-> OpenTelemetryConfig -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OpenTelemetryConfig
otelConfig
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

-- | Set just the "status" field of the OpenTelemetry configuration.
runSetOpenTelemetryStatus ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  OtelStatus ->
  m EncJSON
runSetOpenTelemetryStatus :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m, CacheRWM m) =>
OtelStatus -> m EncJSON
runSetOpenTelemetryStatus OtelStatus
otelStatus = do
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (OpenTelemetryConfigSubobject -> MetadataObjId
MOOpenTelemetry OpenTelemetryConfigSubobject
OtelSubobjectAll)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (OpenTelemetryConfig -> Identity OpenTelemetryConfig)
-> Metadata -> Identity Metadata
Lens' Metadata OpenTelemetryConfig
metaOpenTelemetryConfig
    ((OpenTelemetryConfig -> Identity OpenTelemetryConfig)
 -> Metadata -> Identity Metadata)
-> ((OtelStatus -> Identity OtelStatus)
    -> OpenTelemetryConfig -> Identity OpenTelemetryConfig)
-> (OtelStatus -> Identity OtelStatus)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OtelStatus -> Identity OtelStatus)
-> OpenTelemetryConfig -> Identity OpenTelemetryConfig
Lens' OpenTelemetryConfig OtelStatus
ocStatus
    ((OtelStatus -> Identity OtelStatus)
 -> Metadata -> Identity Metadata)
-> OtelStatus -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OtelStatus
otelStatus
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

-- | Smart constructor for 'OtelExporterInfo'.
--
-- Returns a @Left qErr@ to signal a validation error. Returns @Right Nothing@
-- to signal that the exporter should be disabled without raising an error.
--
-- Allows the trace endpoint to be unset if the entire OpenTelemetry system is
-- disabled.
parseOtelExporterConfig ::
  OtelStatus ->
  Environment ->
  OtelExporterConfig ->
  Either QErr (Maybe OtelExporterInfo)
parseOtelExporterConfig :: OtelStatus
-> Environment
-> OtelExporterConfig
-> Either QErr (Maybe OtelExporterInfo)
parseOtelExporterConfig OtelStatus
otelStatus Environment
env OtelExporterConfig {[HeaderConf]
[NameValue]
Maybe Text
OtlpProtocol
_oecTracesEndpoint :: Maybe Text
_oecProtocol :: OtlpProtocol
_oecHeaders :: [HeaderConf]
_oecResourceAttributes :: [NameValue]
_oecTracesEndpoint :: OtelExporterConfig -> Maybe Text
_oecProtocol :: OtelExporterConfig -> OtlpProtocol
_oecHeaders :: OtelExporterConfig -> [HeaderConf]
_oecResourceAttributes :: OtelExporterConfig -> [NameValue]
..} = do
  -- First validate everything but the trace endpoint
  [Header]
headers <- Environment -> [HeaderConf] -> Either QErr [Header]
forall (m :: * -> *).
MonadError QErr m =>
Environment -> [HeaderConf] -> m [Header]
makeHeadersFromConf Environment
env [HeaderConf]
_oecHeaders
  -- Allow the trace endpoint to be unset when OpenTelemetry is disabled
  case Maybe Text
_oecTracesEndpoint of
    Maybe Text
Nothing ->
      case OtelStatus
otelStatus of
        OtelStatus
OtelDisabled ->
          Maybe OtelExporterInfo -> Either QErr (Maybe OtelExporterInfo)
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OtelExporterInfo
forall a. Maybe a
Nothing
        OtelStatus
OtelEnabled -> QErr -> Either QErr (Maybe OtelExporterInfo)
forall a b. a -> Either a b
Left (Code -> Text -> QErr
err400 Code
InvalidParams Text
"Missing traces endpoint")
    Just Text
rawTracesEndpoint -> do
      URI
tracesUri <-
        QErr -> Maybe URI -> Either QErr URI
forall a b. a -> Maybe b -> Either a b
maybeToEither (Code -> Text -> QErr
err400 Code
InvalidParams Text
"Invalid URL")
          (Maybe URI -> Either QErr URI) -> Maybe URI -> Either QErr URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURI
          (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
rawTracesEndpoint
      Request
uriRequest <-
        (SomeException -> QErr)
-> Either SomeException Request -> Either QErr Request
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 (Code -> Text -> QErr
err400 Code
InvalidParams (Text -> QErr) -> (SomeException -> Text) -> SomeException -> QErr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Text
forall a. Show a => a -> Text
tshow) (Either SomeException Request -> Either QErr Request)
-> Either SomeException Request -> Either QErr Request
forall a b. (a -> b) -> a -> b
$ URI -> Either SomeException Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
requestFromURI URI
tracesUri
      Maybe OtelExporterInfo -> Either QErr (Maybe OtelExporterInfo)
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Maybe OtelExporterInfo -> Either QErr (Maybe OtelExporterInfo))
-> Maybe OtelExporterInfo -> Either QErr (Maybe OtelExporterInfo)
forall a b. (a -> b) -> a -> b
$ OtelExporterInfo -> Maybe OtelExporterInfo
forall a. a -> Maybe a
Just
        (OtelExporterInfo -> Maybe OtelExporterInfo)
-> OtelExporterInfo -> Maybe OtelExporterInfo
forall a b. (a -> b) -> a -> b
$ OtelExporterInfo
          { _oteleiTracesBaseRequest :: Request
_oteleiTracesBaseRequest =
              Request
uriRequest
                { requestHeaders :: [Header]
requestHeaders = [Header]
headers [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ Request -> [Header]
requestHeaders Request
uriRequest
                },
            _oteleiResourceAttributes :: Map Text Text
_oteleiResourceAttributes =
              [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ (NameValue -> (Text, Text)) -> [NameValue] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map
                  (\NameValue {Text
nv_name :: Text
nv_name :: NameValue -> Text
nv_name, Text
nv_value :: Text
nv_value :: NameValue -> Text
nv_value} -> (Text
nv_name, Text
nv_value))
                  [NameValue]
_oecResourceAttributes
          }

-- Smart constructor. Consistent with defaults.
parseOtelBatchSpanProcessorConfig ::
  OtelBatchSpanProcessorConfig -> Either QErr OtelBatchSpanProcessorInfo
parseOtelBatchSpanProcessorConfig :: OtelBatchSpanProcessorConfig
-> Either QErr OtelBatchSpanProcessorInfo
parseOtelBatchSpanProcessorConfig OtelBatchSpanProcessorConfig {Int
_obspcMaxExportBatchSize :: Int
_obspcMaxExportBatchSize :: OtelBatchSpanProcessorConfig -> Int
..} = do
  Int
_obspiMaxExportBatchSize <-
    if Int
_obspcMaxExportBatchSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      then Int -> Either QErr Int
forall a b. b -> Either a b
Right Int
_obspcMaxExportBatchSize
      else QErr -> Either QErr Int
forall a b. a -> Either a b
Left (Code -> Text -> QErr
err400 Code
InvalidParams Text
"max_export_batch_size must be a positive integer")
  let _obspiMaxQueueSize :: Int
_obspiMaxQueueSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
_obspiMaxExportBatchSize -- consistent with default value of 2048
  OtelBatchSpanProcessorInfo
-> Either QErr OtelBatchSpanProcessorInfo
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OtelBatchSpanProcessorInfo {Int
_obspiMaxExportBatchSize :: Int
_obspiMaxQueueSize :: Int
_obspiMaxExportBatchSize :: Int
_obspiMaxQueueSize :: Int
..}