LogRecord.hs

module Effectful.OpenTelemetry.Logging.LogRecord where

import Data.Aeson.Types (ToJSON (..), Value (..), object, (.=))
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Effectful.OpenTelemetry.Logging.Severity (Severity)
import Effectful.OpenTelemetry.Protocol (AnyValue (..), Attributes)
import Effectful.OpenTelemetry.Protocol.Export qualified as Export
import Effectful.OpenTelemetry.Protocol.Resource qualified as Resource
import Effectful.OpenTelemetry.Protocol.Scope qualified as Scope
import Effectful.OpenTelemetry.Timestamp (Timestamp)
import Effectful.OpenTelemetry.Tracing.Span.Context qualified as Span
import GHC.Generics (Generic)
import Network.GRPC.HTTP2.Proto3Wire (RPC (..))
import Prettyprinter (Pretty (..))
import Prettyprinter.Extra (PrettyAnn (..))
import Prettyprinter.Extra qualified as Pretty
import Prettyprinter.Render.Terminal (AnsiStyle)
import Proto3.Wire.Encode.Class qualified as Proto
import Prelude hiding (String)

-- | Represents the recording of an event.
--
-- See <https://opentelemetry.io/docs/concepts/signals/logs/#log-record the OpenTelemetry spec>.
data LogRecord = LogRecord
    { timestamp :: Timestamp
    -- ^ Time when the event occured.
    , observedTimestamp :: Timestamp
    -- ^ Time when the event was observed by the collection system.
    , context :: Maybe Span.Context
    -- ^ The tracing context, present if recorded within a span.
    , severity :: Severity
    -- ^ Also known as the log level.
    , body :: Value
    -- ^ Describes the event as structured data.
    -- For a human-readable free-form message, use the 'String' constructor.
    , attributes :: Attributes
    -- ^ Additional information about the event.
    , eventName :: Maybe Text
    -- ^ Identifies the class or type of the event.
    }
    deriving stock (Generic, Eq, Show)

instance ToJSON LogRecord where
    toJSON LogRecord{..} =
        object $
            [ "timeUnixNano" .= timestamp
            , "observedTimeUnixNano" .= observedTimestamp
            , "severityNumber" .= (Number . fromIntegral . fromEnum) severity
            , "body" .= AnyValue body
            , "attributes" .= attributes
            ]
                <> catMaybes
                    [ ("flags" .=) <$> (context <&> (.traceFlags))
                    , ("traceId" .=) <$> (context <&> (.traceId))
                    , ("spanId" .=) <$> (context <&> (.spanId))
                    , ("eventName" .=) <$> eventName
                    ]

instance Proto.Encode LogRecord where
    encode LogRecord{..} =
        mconcat
            [ Proto.encodeField 1 timestamp
            , Proto.encodeField 11 observedTimestamp
            , Proto.encodeField 2 severity
            , -- 3: severity_text: not needed
              Proto.encodeField 5 body
            , Proto.encodeField 6 attributes
            , -- 7: dropped_attributes_count: Not supported
              flip foldMap context \Span.Context{..} ->
                mconcat
                    [ Proto.encodeField 8 traceFlags
                    , Proto.encodeField 9 traceId
                    , Proto.encodeField 10 spanId
                    ]
            , foldMap (Proto.encodeField 12) eventName
            ]

instance PrettyAnn AnsiStyle LogRecord where
    prettyAnn LogRecord{..} =
        Pretty.unwords . filter (not . Pretty.null) $
            [ prettyAnn timestamp
            , prettyAnn severity
            , eventName & maybe mempty \n -> pretty $ "[" <> n <> "]"
            , prettyAnn body
            , prettyAnn attributes
            ]

instance Export.Request LogRecord where
    exportHttpPathComponents = ["v1", "logs"]
    exportGrpcRPC =
        RPC
            { pkg = "opentelemetry.proto.collector.logs.v1"
            , srv = "LogsService"
            , meth = "Export"
            }
    exportJson = object . pure . ("resourceLogs" .=) . fmap resourceLogs
      where
        resourceLogs :: Resource.Items LogRecord -> Value
        resourceLogs Resource.Items{resource, scopeItems} =
            object
                [ "resource" .= resource
                , "scopeLogs" .= fmap scopeLogs scopeItems
                ]
        scopeLogs :: Scope.Items LogRecord -> Value
        scopeLogs Scope.Items{..} =
            object
                [ "scope" .= scope
                , "logRecords" .= items
                ]

    transportSignalEnvName = "LOGS"
    batchEnvPrefix = Just "BLRP"

    -- https://opentelemetry.io/docs/specs/otel/logs/sdk/#batching-processor
    defaultConfig =
        Export.Config
            { batch =
                Just
                    Export.BatchConfig
                        { maxQueueSize = 2_048
                        , scheduledDelayMs = 1_000
                        , maxBatchSize = 512
                        }
            , exportTimeoutMs = 30_000
            }