otel-effectful-1.0.0: src/Effectful/OpenTelemetry/Logging/Effect.hs

module Effectful.OpenTelemetry.Logging.Effect
    ( -- * Effect
      Logging
    , runLogging
    , runHttpLogging
    , runGrpcLogging
    , runConsoleLogging
    , runInMemoryLogging
    , runLoggingWith
    , runNoLogging
    , withTracing

      -- * Emit logs
    , log
    )
where

import Control.Monad.Extra (ifM)
import Data.Aeson.Types (Value)
import Data.Text (Text)
import Effectful
import Effectful.Concurrent (Concurrent)
import Effectful.Dispatch.Static
import Effectful.Environment (Environment)
import Effectful.Http2Client (HostName, PortNumber)
import Effectful.HttpClient (responseTimeoutDefault)
import Effectful.OpenTelemetry.Exporter (Exporter)
import Effectful.OpenTelemetry.Exporter qualified as Exporter
import Effectful.OpenTelemetry.Exporter.Console qualified as Console
import Effectful.OpenTelemetry.Exporter.Environment qualified as Exporter.Environment
import Effectful.OpenTelemetry.Exporter.OTLP (defaultGrpcSendTimeout)
import Effectful.OpenTelemetry.Logging.LogRecord (LogRecord (..))
import Effectful.OpenTelemetry.Logging.Severity (Severity)
import Effectful.OpenTelemetry.Protocol.Attributes (Attributes)
import Effectful.OpenTelemetry.Protocol.Effect
    ( OTLP
    , exportIO
    , runInMemoryOTLP
    , runNoOTLP
    , runOTLPWith
    )
import Effectful.OpenTelemetry.Protocol.Environment qualified as Environment
import Effectful.OpenTelemetry.Protocol.Export qualified as Export
import Effectful.OpenTelemetry.Protocol.Resource (Resource)
import Effectful.OpenTelemetry.Protocol.Scope (Scope)
import Effectful.OpenTelemetry.Protocol.Transport
    ( Compression
    , Encoding
    )
import Effectful.OpenTelemetry.Timestamp qualified as Timestamp
import Effectful.OpenTelemetry.Tracing.Effect (Tracing, currentContextIO)
import Effectful.OpenTelemetry.Tracing.Span.Context qualified as Span (Context)
import Effectful.Retry (Retry)
import Effectful.Timeout (Timeout)
import Network.URI (URI)
import Prelude hiding (log)

data Logging :: Effect

type instance DispatchOf Logging = 'Static 'WithSideEffects

data instance StaticRep Logging = Logging
    { getContext :: IO (Maybe Span.Context)
    , export :: LogRecord -> IO ()
    }

withTracing :: (Logging :> es, Tracing :> es) => Eff es a -> Eff es a
withTracing eff = do
    getContext <- currentContextIO
    localStaticRep (\logging -> logging{getContext}) eff

-- | Emit a single log record with the current 'Timestamp.Timestamp' and 'Tracing' context, if any.
-- This function can be used without 'Tracing' as well.
log
    :: (Logging :> es)
    => Severity
    -> Value
    -> Attributes
    -> Maybe Text
    -> Eff es ()
log severity body attributes eventName = do
    Logging{..} <- getStaticRep
    unsafeEff_ do
        timestamp <- Timestamp.now
        context <- getContext
        export LogRecord{observedTimestamp = timestamp, ..}

runLoggingState
    :: (IOE :> es, OTLP LogRecord :> es, Tracing :> es)
    => Eff (Logging ': es) a
    -> Eff es a
runLoggingState eff = do
    getContext <- currentContextIO
    runLoggingState' getContext eff

runLoggingState'
    :: (IOE :> es, OTLP LogRecord :> es)
    => IO (Maybe Span.Context)
    -> Eff (Logging ': es) a
    -> Eff es a
runLoggingState' getContext eff = do
    export <- exportIO
    evalStaticRep (Logging{..}) eff

-- | Run the 'Logging' effect, sending telemetry to an exporter.
-- Uses the 'Tracing' effect to enrich logs with span context.
-- Reads the configuration from <https://opentelemetry.io/docs/specs/otel/configuration/sdk-environment-variables/#general-sdk-configuration the standard environment variables>.
-- Delegates to 'runNoLogging' if @OTEL_SDK_DISABLED = true@.
runLogging
    :: ( Tracing :> es
       , IOE :> es
       , Concurrent :> es
       , Environment :> es
       , Retry :> es
       , Timeout :> es
       )
    => Resource
    -> Scope
    -> Eff (Logging ': es) a
    -> Eff es a
runLogging resource scope eff =
    ifM Environment.isSdkDisabled (runNoLogging eff) do
        exporter <- Environment.runConfigError $ Exporter.Environment.lookup @LogRecord resource scope
        runLoggingWith exporter eff

-- | Run the 'Logging' effect, sending telemetry to a collector at the given 'URI'
-- over HTTP with the given 'Encoding'.
-- Uses the 'Tracing' effect to enrich logs with span context.
runHttpLogging
    :: (IOE :> es, Concurrent :> es, Retry :> es, Timeout :> es, Tracing :> es)
    => Resource
    -> Scope
    -> Encoding
    -> Compression
    -> URI
    -> Eff (Logging ': es) a
    -> Eff es a
runHttpLogging resource scope encoding compression endpoint =
    runLoggingWith $
        Exporter.http @LogRecord
            resource
            scope
            encoding
            endpoint
            (Export.defaultConfig @LogRecord)
            compression
            responseTimeoutDefault

-- | Run the 'Logging' effect, sending telemetry to a gRPC collector.
-- Uses the 'Tracing' effect to enrich logs with span context.
runGrpcLogging
    :: (IOE :> es, Concurrent :> es, Retry :> es, Timeout :> es, Tracing :> es)
    => Resource
    -> Scope
    -> HostName
    -> PortNumber
    -> Compression
    -> Eff (Logging ': es) a
    -> Eff es a
runGrpcLogging resource scope host port compression =
    runLoggingWith $
        Exporter.grpc @LogRecord
            resource
            scope
            host
            port
            (Export.exportGrpcRPC @LogRecord)
            (Export.defaultConfig @LogRecord)
            compression
            defaultGrpcSendTimeout

-- | Run the 'Logging' effect, printing telemetry to the console rather than sending to a collector.
runConsoleLogging :: (IOE :> es, Tracing :> es) => Eff (Logging ': es) a -> Eff es a
runConsoleLogging = runLoggingWith Console.stdout

-- | Run the 'Logging' effect, collecting telemetry in-memory rather than sending to a collector.
-- Uses the 'Tracing' effect to enrich logs with span context.
runInMemoryLogging
    :: (IOE :> es, Concurrent :> es, Tracing :> es)
    => Eff (Logging ': es) a
    -> Eff es (a, [LogRecord])
runInMemoryLogging = runInMemoryOTLP @LogRecord . runLoggingState . inject

-- | Run the 'Logging' effect with a given 'Exporter'.
-- Passes records to the exporter synchronously as they are emitted, without batching or retrying.
-- Uses the 'Tracing' effect to enrich logs with span context.
runLoggingWith
    :: (IOE :> es, Tracing :> es)
    => Exporter es LogRecord
    -> Eff (Logging ': es) a
    -> Eff es a
runLoggingWith exporter = runOTLPWith exporter . runLoggingState . inject

-- | Run the 'Logging' effect as a no-op action.
runNoLogging :: (IOE :> es) => Eff (Logging ': es) a -> Eff es a
runNoLogging = runNoOTLP @LogRecord . runLoggingState' (pure Nothing) . inject