{-# LANGUAGE NamedFieldPuns #-}

module OpenTelemetry.Internal.Logs.Types (
  LogRecordExporter,
  LogRecordExporterArguments (..),
  mkLogRecordExporter,
  logRecordExporterExport,
  logRecordExporterForceFlush,
  logRecordExporterShutdown,
  LogRecordProcessor (..),
  LoggerProvider (..),
  Logger (..),
  ReadWriteLogRecord,
  mkReadWriteLogRecord,
  ReadableLogRecord,
  mkReadableLogRecord,
  IsReadableLogRecord (..),
  IsReadWriteLogRecord (..),
  ImmutableLogRecord (..),
  LogRecordArguments (..),
  emptyLogRecordArguments,
  SeverityNumber (..),
  toShortName,
) where

import Control.Concurrent (MVar, newMVar, withMVar)
import Control.Concurrent.Async
import Data.Function (on)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.IORef (IORef, atomicModifyIORef, modifyIORef, newIORef, readIORef)
import Data.Text (Text)
import Data.Vector (Vector)
import OpenTelemetry.Common (Timestamp, TraceFlags)
import OpenTelemetry.Context.Types (Context)
import OpenTelemetry.Internal.Common.Types (ExportResult, InstrumentationLibrary, ShutdownResult)
import OpenTelemetry.Internal.Trace.Id (SpanId, TraceId)
import OpenTelemetry.LogAttributes
import OpenTelemetry.Resource (MaterializedResources)


-- | See @LogRecordExporter@ for documentation
data LogRecordExporterArguments = LogRecordExporterArguments
  { LogRecordExporterArguments
-> Vector ReadableLogRecord -> IO ExportResult
logRecordExporterArgumentsExport :: Vector ReadableLogRecord -> IO ExportResult
  -- ^ See @logRecordExporterExport@ for documentation
  , LogRecordExporterArguments -> IO ()
logRecordExporterArgumentsForceFlush :: IO ()
  -- ^ See @logRecordExporterArgumentsForceFlush@ for documentation
  , LogRecordExporterArguments -> IO ()
logRecordExporterArgumentsShutdown :: IO ()
  -- ^ See @logRecordExporterArgumentsShutdown@ for documentation
  }


{- | @LogRecordExporter@ defines the interface that protocol-specific exporters must implement so that they can be plugged into OpenTelemetry SDK and support sending of telemetry data.

The goal of the interface is to minimize burden of implementation for protocol-dependent telemetry exporters. The protocol exporter is expected to be primarily a simple telemetry data encoder and transmitter.

@LogRecordExporter@s provide thread safety when calling @logRecordExporterExport@
-}
newtype LogRecordExporter = LogRecordExporter {LogRecordExporter -> MVar LogRecordExporterArguments
unExporter :: MVar LogRecordExporterArguments}


mkLogRecordExporter :: LogRecordExporterArguments -> IO LogRecordExporter
mkLogRecordExporter :: LogRecordExporterArguments -> IO LogRecordExporter
mkLogRecordExporter = (MVar LogRecordExporterArguments -> LogRecordExporter)
-> IO (MVar LogRecordExporterArguments) -> IO LogRecordExporter
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVar LogRecordExporterArguments -> LogRecordExporter
LogRecordExporter (IO (MVar LogRecordExporterArguments) -> IO LogRecordExporter)
-> (LogRecordExporterArguments
    -> IO (MVar LogRecordExporterArguments))
-> LogRecordExporterArguments
-> IO LogRecordExporter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogRecordExporterArguments -> IO (MVar LogRecordExporterArguments)
forall a. a -> IO (MVar a)
newMVar


{- | Exports a batch of ReadableLogRecords. Protocol exporters that will implement this function are typically expected to serialize
and transmit the data to the destination.

Export will never be called concurrently for the same exporter instance. Depending on the implementation the result of the export
may be returned to the Processor not in the return value of the call to Export but in a language specific way for signaling completion
of an asynchronous task. This means that while an instance of an exporter will never have it Export called concurrently it does not
mean that the task of exporting can not be done concurrently. How this is done is outside the scope of this specification.
Each implementation MUST document the concurrency characteristics the SDK requires of the exporter.

Export MUST NOT block indefinitely, there MUST be a reasonable upper limit after which the call must time out with an error result (Failure).

Concurrent requests and retry logic is the responsibility of the exporter. The default SDK’s LogRecordProcessors SHOULD NOT implement
retry logic, as the required logic is likely to depend heavily on the specific protocol and backend the logs are being sent to.
For example, the OpenTelemetry Protocol (OTLP) specification defines logic for both sending concurrent requests and retrying requests.

Result:
Success - The batch has been successfully exported. For protocol exporters this typically means that the data is sent over the wire and delivered to the destination server.
Failure - exporting failed. The batch must be dropped. For example, this can happen when the batch contains bad data and cannot be serialized.
-}
logRecordExporterExport :: LogRecordExporter -> Vector ReadableLogRecord -> IO ExportResult
logRecordExporterExport :: LogRecordExporter -> Vector ReadableLogRecord -> IO ExportResult
logRecordExporterExport LogRecordExporter
exporter Vector ReadableLogRecord
lrs = MVar LogRecordExporterArguments
-> (LogRecordExporterArguments -> IO ExportResult)
-> IO ExportResult
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (LogRecordExporter -> MVar LogRecordExporterArguments
unExporter LogRecordExporter
exporter) ((LogRecordExporterArguments -> IO ExportResult)
 -> IO ExportResult)
-> (LogRecordExporterArguments -> IO ExportResult)
-> IO ExportResult
forall a b. (a -> b) -> a -> b
$ \LogRecordExporterArguments
e -> LogRecordExporterArguments
-> Vector ReadableLogRecord -> IO ExportResult
logRecordExporterArgumentsExport LogRecordExporterArguments
e Vector ReadableLogRecord
lrs


{- | This is a hint to ensure that the export of any ReadableLogRecords the exporter has received prior to the call to ForceFlush SHOULD
be completed as soon as possible, preferably before returning from this method.

ForceFlush SHOULD provide a way to let the caller know whether it succeeded, failed or timed out.

ForceFlush SHOULD only be called in cases where it is absolutely necessary, such as when using some FaaS providers that may suspend
the process after an invocation, but before the exporter exports the ReadlableLogRecords.

ForceFlush SHOULD complete or abort within some timeout. ForceFlush can be implemented as a blocking API or an asynchronous API which
notifies the caller via a callback or an event. OpenTelemetry SDK authors MAY decide if they want to make the flush timeout configurable.
-}
logRecordExporterForceFlush :: LogRecordExporter -> IO ()
logRecordExporterForceFlush :: LogRecordExporter -> IO ()
logRecordExporterForceFlush = (MVar LogRecordExporterArguments
 -> (LogRecordExporterArguments -> IO ()) -> IO ())
-> (LogRecordExporterArguments -> IO ())
-> MVar LogRecordExporterArguments
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar LogRecordExporterArguments
-> (LogRecordExporterArguments -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar LogRecordExporterArguments -> IO ()
logRecordExporterArgumentsForceFlush (MVar LogRecordExporterArguments -> IO ())
-> (LogRecordExporter -> MVar LogRecordExporterArguments)
-> LogRecordExporter
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogRecordExporter -> MVar LogRecordExporterArguments
unExporter


{- | Shuts down the exporter. Called when SDK is shut down. This is an opportunity for exporter to do any cleanup required.

Shutdown SHOULD be called only once for each LogRecordExporter instance. After the call to Shutdown subsequent calls to Export are not
allowed and SHOULD return a Failure result.

Shutdown SHOULD NOT block indefinitely (e.g. if it attempts to flush the data and the destination is unavailable).
OpenTelemetry SDK authors MAY decide if they want to make the shutdown timeout configurable.
-}
logRecordExporterShutdown :: LogRecordExporter -> IO ()
logRecordExporterShutdown :: LogRecordExporter -> IO ()
logRecordExporterShutdown = (MVar LogRecordExporterArguments
 -> (LogRecordExporterArguments -> IO ()) -> IO ())
-> (LogRecordExporterArguments -> IO ())
-> MVar LogRecordExporterArguments
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar LogRecordExporterArguments
-> (LogRecordExporterArguments -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar LogRecordExporterArguments -> IO ()
logRecordExporterArgumentsShutdown (MVar LogRecordExporterArguments -> IO ())
-> (LogRecordExporter -> MVar LogRecordExporterArguments)
-> LogRecordExporter
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogRecordExporter -> MVar LogRecordExporterArguments
unExporter


{- | LogRecordProcessor is an interface which allows hooks for LogRecord emitting.

Built-in processors are responsible for batching and conversion of LogRecords to exportable representation and passing batches to exporters.

LogRecordProcessors can be registered directly on SDK LoggerProvider and they are invoked in the same order as they were registered.

Each processor registered on LoggerProvider is part of a pipeline that consists of a processor and optional exporter. The SDK MUST allow each pipeline to end with an individual exporter.

The SDK MUST allow users to implement and configure custom processors and decorate built-in processors for advanced scenarios such as enriching with attributes.

The following diagram shows LogRecordProcessor’s relationship to other components in the SDK:

+-----+------------------------+   +------------------------------+   +-------------------------+
|     |                        |   |                              |   |                         |
|     |                        |   | Batching LogRecordProcessor  |   |    LogRecordExporter    |
|     |                        +---> Simple LogRecordProcessor    +--->     (OtlpExporter)      |
|     |                        |   |                              |   |                         |
| SDK | Logger.emit(LogRecord) |   +------------------------------+   +-------------------------+
|     |                        |
|     |                        |
|     |                        |
|     |                        |
|     |                        |
+-----+------------------------+
-}
data LogRecordProcessor = LogRecordProcessor
  { LogRecordProcessor -> ReadWriteLogRecord -> Context -> IO ()
logRecordProcessorOnEmit :: ReadWriteLogRecord -> Context -> IO ()
  -- ^ Called when a LogRecord is emitted. This method is called synchronously on the thread that emitted the LogRecord, therefore it SHOULD NOT block or throw exceptions.
  --
  -- A LogRecordProcessor may freely modify logRecord for the duration of the OnEmit call. If logRecord is needed after OnEmit returns (i.e. for asynchronous processing) only reads are permitted.
  , LogRecordProcessor -> IO (Async ShutdownResult)
logRecordProcessorShutdown :: IO (Async ShutdownResult)
  -- ^ Shuts down the processor. Called when SDK is shut down. This is an opportunity for processor to do any cleanup required.
  --
  -- Shutdown SHOULD be called only once for each LogRecordProcessor instance. After the call to Shutdown, subsequent calls to OnEmit are not allowed. SDKs SHOULD ignore these calls gracefully, if possible.
  --
  -- Shutdown SHOULD provide a way to let the caller know whether it succeeded, failed or timed out.
  --
  -- Shutdown MUST include the effects of ForceFlush.
  --
  -- Shutdown SHOULD complete or abort within some timeout. Shutdown can be implemented as a blocking API or an asynchronous API which notifies the caller via a callback or an event.
  -- OpenTelemetry SDK authors can decide if they want to make the shutdown timeout configurable.
  , LogRecordProcessor -> IO ()
logRecordProcessorForceFlush :: IO ()
  -- ^ This is a hint to ensure that any tasks associated with LogRecords for which the LogRecordProcessor had already received events prior to the call to ForceFlush SHOULD be completed
  -- as soon as possible, preferably before returning from this method.
  --
  -- In particular, if any LogRecordProcessor has any associated exporter, it SHOULD try to call the exporter’s Export with all LogRecords for which this was not already done and then invoke ForceFlush on it.
  -- The built-in LogRecordProcessors MUST do so. If a timeout is specified (see below), the LogRecordProcessor MUST prioritize honoring the timeout over finishing all calls. It MAY skip or abort some or all
  -- Export or ForceFlush calls it has made to achieve this goal.
  --
  -- ForceFlush SHOULD provide a way to let the caller know whether it succeeded, failed or timed out.
  --
  -- ForceFlush SHOULD only be called in cases where it is absolutely necessary, such as when using some FaaS providers that may suspend the process after an invocation, but before the LogRecordProcessor exports the emitted LogRecords.
  --
  -- ForceFlush SHOULD complete or abort within some timeout. ForceFlush can be implemented as a blocking API or an asynchronous API which notifies the caller via a callback or an event. OpenTelemetry SDK authors
  -- can decide if they want to make the flush timeout configurable.
  }


-- | @Logger@s can be created from @LoggerProvider@s
data LoggerProvider = LoggerProvider
  { LoggerProvider -> Vector LogRecordProcessor
loggerProviderProcessors :: Vector LogRecordProcessor
  , LoggerProvider -> MaterializedResources
loggerProviderResource :: MaterializedResources
  -- ^ Describes the source of the log, aka resource. Multiple occurrences of events coming from the same event source can happen across time and they all have the same value of Resource.
  -- Can contain for example information about the application that emits the record or about the infrastructure where the application runs. Data formats that represent this data model
  -- may be designed in a manner that allows the Resource field to be recorded only once per batch of log records that come from the same source. SHOULD follow OpenTelemetry semantic conventions for Resources.
  -- This field is optional.
  , LoggerProvider -> AttributeLimits
loggerProviderAttributeLimits :: AttributeLimits
  }


{- | @LogRecords@ can be created from @Loggers@. @Logger@s are uniquely identified by the @libraryName@, @libraryVersion@, @schemaUrl@ fields of @InstrumentationLibrary@.
Creating two @Logger@s with the same identity but different @libraryAttributes@ is a user error.
-}
data Logger = Logger
  { Logger -> InstrumentationLibrary
loggerInstrumentationScope :: InstrumentationLibrary
  -- ^ Details about the library that the @Logger@ instruments.
  , Logger -> LoggerProvider
loggerLoggerProvider :: LoggerProvider
  -- ^ The @LoggerProvider@ that created this @Logger@. All configuration for the @Logger@ is contained in the @LoggerProvider@.
  }


{- | This is a data type that can represent logs from various sources: application log files, machine generated events, system logs, etc. [Specification outlined here.](https://opentelemetry.io/docs/specs/otel/logs/data-model/)
Existing log formats can be unambiguously mapped to this data type. Reverse mapping from this data type is also possible to the extent that the target log format has equivalent capabilities.
Uses an IORef under the hood to allow mutability.
-}
data ReadWriteLogRecord = ReadWriteLogRecord Logger (IORef ImmutableLogRecord)


mkReadWriteLogRecord :: Logger -> ImmutableLogRecord -> IO ReadWriteLogRecord
mkReadWriteLogRecord :: Logger -> ImmutableLogRecord -> IO ReadWriteLogRecord
mkReadWriteLogRecord Logger
l = (IORef ImmutableLogRecord -> ReadWriteLogRecord)
-> IO (IORef ImmutableLogRecord) -> IO ReadWriteLogRecord
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Logger -> IORef ImmutableLogRecord -> ReadWriteLogRecord
ReadWriteLogRecord Logger
l) (IO (IORef ImmutableLogRecord) -> IO ReadWriteLogRecord)
-> (ImmutableLogRecord -> IO (IORef ImmutableLogRecord))
-> ImmutableLogRecord
-> IO ReadWriteLogRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImmutableLogRecord -> IO (IORef ImmutableLogRecord)
forall a. a -> IO (IORef a)
newIORef


newtype ReadableLogRecord = ReadableLogRecord {ReadableLogRecord -> ReadWriteLogRecord
readableLogRecord :: ReadWriteLogRecord}


mkReadableLogRecord :: ReadWriteLogRecord -> ReadableLogRecord
mkReadableLogRecord :: ReadWriteLogRecord -> ReadableLogRecord
mkReadableLogRecord = ReadWriteLogRecord -> ReadableLogRecord
ReadableLogRecord


{- | This is a typeclass representing @LogRecord@s that can be read from.

A function receiving this as an argument MUST be able to access all the information added to the LogRecord. It MUST also be able to access the Instrumentation Scope and Resource information (implicitly) associated with the LogRecord.

The trace context fields MUST be populated from the resolved Context (either the explicitly passed Context or the current Context) when emitted.

Counts for attributes due to collection limits MUST be available for exporters to report as described in the transformation to non-OTLP formats specification.
-}
class IsReadableLogRecord r where
  -- | Reads the current state of the @LogRecord@ from its internal @IORef@. The implementation mirrors @readIORef@.
  readLogRecord :: r -> IO ImmutableLogRecord


  -- | Reads the @InstrumentationScope@ from the @Logger@ that emitted the @LogRecord@
  readLogRecordInstrumentationScope :: r -> InstrumentationLibrary


  -- | Reads the @Resource@ from the @LoggerProvider@ that emitted the @LogRecord@
  readLogRecordResource :: r -> MaterializedResources


{- | This is a typeclass representing @LogRecord@s that can be read from or written to. All @ReadWriteLogRecord@s are @ReadableLogRecord@s.

A function receiving this as an argument MUST additionally be able to modify the following information added to the LogRecord:

- Timestamp
- ObservedTimestamp
- SeverityText
- SeverityNumber
- Body
- Attributes (addition, modification, removal)
- TraceId
- SpanId
- TraceFlags
-}
class (IsReadableLogRecord r) => IsReadWriteLogRecord r where
  -- | Reads the attribute limits from the @LoggerProvider@ that emitted the @LogRecord@. These are needed to add more attributes.
  readLogRecordAttributeLimits :: r -> AttributeLimits


  -- | Modifies the @LogRecord@ using its internal @IORef@. This is lazy and is not an atomic operation. The implementation mirrors @modifyIORef@.
  modifyLogRecord :: r -> (ImmutableLogRecord -> ImmutableLogRecord) -> IO ()


  -- | An atomic version of @modifyLogRecord@. This function is lazy. The implementation mirrors @atomicModifyIORef@.
  atomicModifyLogRecord :: r -> (ImmutableLogRecord -> (ImmutableLogRecord, b)) -> IO b


instance IsReadableLogRecord ReadableLogRecord where
  readLogRecord :: ReadableLogRecord -> IO ImmutableLogRecord
readLogRecord = ReadWriteLogRecord -> IO ImmutableLogRecord
forall r. IsReadableLogRecord r => r -> IO ImmutableLogRecord
readLogRecord (ReadWriteLogRecord -> IO ImmutableLogRecord)
-> (ReadableLogRecord -> ReadWriteLogRecord)
-> ReadableLogRecord
-> IO ImmutableLogRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadableLogRecord -> ReadWriteLogRecord
readableLogRecord
  readLogRecordInstrumentationScope :: ReadableLogRecord -> InstrumentationLibrary
readLogRecordInstrumentationScope = ReadWriteLogRecord -> InstrumentationLibrary
forall r. IsReadableLogRecord r => r -> InstrumentationLibrary
readLogRecordInstrumentationScope (ReadWriteLogRecord -> InstrumentationLibrary)
-> (ReadableLogRecord -> ReadWriteLogRecord)
-> ReadableLogRecord
-> InstrumentationLibrary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadableLogRecord -> ReadWriteLogRecord
readableLogRecord
  readLogRecordResource :: ReadableLogRecord -> MaterializedResources
readLogRecordResource = ReadWriteLogRecord -> MaterializedResources
forall r. IsReadableLogRecord r => r -> MaterializedResources
readLogRecordResource (ReadWriteLogRecord -> MaterializedResources)
-> (ReadableLogRecord -> ReadWriteLogRecord)
-> ReadableLogRecord
-> MaterializedResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadableLogRecord -> ReadWriteLogRecord
readableLogRecord


instance IsReadableLogRecord ReadWriteLogRecord where
  readLogRecord :: ReadWriteLogRecord -> IO ImmutableLogRecord
readLogRecord (ReadWriteLogRecord Logger
_ IORef ImmutableLogRecord
ref) = IORef ImmutableLogRecord -> IO ImmutableLogRecord
forall a. IORef a -> IO a
readIORef IORef ImmutableLogRecord
ref
  readLogRecordInstrumentationScope :: ReadWriteLogRecord -> InstrumentationLibrary
readLogRecordInstrumentationScope (ReadWriteLogRecord (Logger {InstrumentationLibrary
loggerInstrumentationScope :: Logger -> InstrumentationLibrary
loggerInstrumentationScope :: InstrumentationLibrary
loggerInstrumentationScope}) IORef ImmutableLogRecord
_) = InstrumentationLibrary
loggerInstrumentationScope
  readLogRecordResource :: ReadWriteLogRecord -> MaterializedResources
readLogRecordResource (ReadWriteLogRecord Logger {loggerLoggerProvider :: Logger -> LoggerProvider
loggerLoggerProvider = LoggerProvider {MaterializedResources
loggerProviderResource :: LoggerProvider -> MaterializedResources
loggerProviderResource :: MaterializedResources
loggerProviderResource}} IORef ImmutableLogRecord
_) = MaterializedResources
loggerProviderResource


instance IsReadWriteLogRecord ReadWriteLogRecord where
  readLogRecordAttributeLimits :: ReadWriteLogRecord -> AttributeLimits
readLogRecordAttributeLimits (ReadWriteLogRecord Logger {loggerLoggerProvider :: Logger -> LoggerProvider
loggerLoggerProvider = LoggerProvider {AttributeLimits
loggerProviderAttributeLimits :: LoggerProvider -> AttributeLimits
loggerProviderAttributeLimits :: AttributeLimits
loggerProviderAttributeLimits}} IORef ImmutableLogRecord
_) = AttributeLimits
loggerProviderAttributeLimits
  modifyLogRecord :: ReadWriteLogRecord
-> (ImmutableLogRecord -> ImmutableLogRecord) -> IO ()
modifyLogRecord (ReadWriteLogRecord Logger
_ IORef ImmutableLogRecord
ref) = IORef ImmutableLogRecord
-> (ImmutableLogRecord -> ImmutableLogRecord) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ImmutableLogRecord
ref
  atomicModifyLogRecord :: forall b.
ReadWriteLogRecord
-> (ImmutableLogRecord -> (ImmutableLogRecord, b)) -> IO b
atomicModifyLogRecord (ReadWriteLogRecord Logger
_ IORef ImmutableLogRecord
ref) = IORef ImmutableLogRecord
-> (ImmutableLogRecord -> (ImmutableLogRecord, b)) -> IO b
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef ImmutableLogRecord
ref


data ImmutableLogRecord = ImmutableLogRecord
  { ImmutableLogRecord -> Maybe Timestamp
logRecordTimestamp :: Maybe Timestamp
  -- ^ Time when the event occurred measured by the origin clock. This field is optional, it may be missing if the timestamp is unknown.
  , ImmutableLogRecord -> Timestamp
logRecordObservedTimestamp :: Timestamp
  -- ^ Time when the event was observed by the collection system. For events that originate in OpenTelemetry (e.g. using OpenTelemetry Logging SDK)
  -- this timestamp is typically set at the generation time and is equal to Timestamp. For events originating externally and collected by OpenTelemetry (e.g. using Collector)
  -- this is the time when OpenTelemetry’s code observed the event measured by the clock of the OpenTelemetry code. This field SHOULD be set once the event is observed by OpenTelemetry.
  --
  -- For converting OpenTelemetry log data to formats that support only one timestamp or when receiving OpenTelemetry log data by recipients that support only one timestamp internally the following logic is recommended:
  -- - Use Timestamp if it is present, otherwise use ObservedTimestamp
  , ImmutableLogRecord -> Maybe (TraceId, SpanId, TraceFlags)
logRecordTracingDetails :: Maybe (TraceId, SpanId, TraceFlags)
  -- ^ Tuple contains three fields:
  --
  -- - Request trace id as defined in W3C Trace Context. Can be set for logs that are part of request processing and have an assigned trace id.
  -- - Span id. Can be set for logs that are part of a particular processing span.
  -- - Trace flag as defined in W3C Trace Context specification. At the time of writing the specification defines one flag - the SAMPLED flag.
  , ImmutableLogRecord -> Maybe Text
logRecordSeverityText :: Maybe Text
  -- ^ severity text (also known as log level). This is the original string representation of the severity as it is known at the source. If this field is missing
  -- and SeverityNumber is present then the short name that corresponds to the SeverityNumber may be used as a substitution. This field is optional.
  , ImmutableLogRecord -> Maybe SeverityNumber
logRecordSeverityNumber :: Maybe SeverityNumber
  -- ^ SeverityNumber is an integer number. Smaller numerical values correspond to less severe events (such as debug events), larger numerical values correspond to
  -- more severe events (such as errors and critical events). The following table defines the meaning of SeverityNumber value:
  --
  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+
  -- | SeverityNumber range  | Range name  | Meaning                                                                                  |
  -- +=======================+=============+==========================================================================================+
  -- | 1-4                   | TRACE       | A fine-grained debugging event. Typically disabled in default configurations.            |
  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+
  -- | 5-8                   | DEBUG       | A debugging event.                                                                       |
  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+
  -- | 9-12                  | INFO        | An informational event. Indicates that an event happened.                                |
  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+
  -- | 13-16                 | WARN        | A warning event. Not an error but is likely more important than an informational event.  |
  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+
  -- | 17-20                 | ERROR       | An error event. Something went wrong.                                                    |
  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+
  -- | 21-24                 | FATAL       | A fatal error such as application or system crash.                                       |
  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+
  -- Smaller numerical values in each range represent less important (less severe) events. Larger numerical values in each range represent more important (more severe) events.
  -- For example SeverityNumber=17 describes an error that is less critical than an error with SeverityNumber=20.
  --
  -- Mappings from existing logging systems and formats (or source format for short) must define how severity (or log level) of that particular format corresponds to SeverityNumber
  -- of this data model based on the meaning given for each range in the above table. [More Information](https://opentelemetry.io/docs/specs/otel/logs/data-model/#mapping-of-severitynumber)
  --
  -- [These short names](https://opentelemetry.io/docs/specs/otel/logs/data-model/#displaying-severity) can be used to represent SeverityNumber in the UI
  --
  -- In the contexts where severity participates in less-than / greater-than comparisons SeverityNumber field should be used.
  -- SeverityNumber can be compared to another SeverityNumber or to numbers in the 1..24 range (or to the corresponding short names).
  , ImmutableLogRecord -> AnyValue
logRecordBody :: AnyValue
  -- ^ A value containing the body of the log record. Can be for example a human-readable string message (including multi-line) describing the event in a free form or it can be a
  -- structured data composed of arrays and maps of other values. Body MUST support any type to preserve the semantics of structured logs emitted by the applications.
  -- Can vary for each occurrence of the event coming from the same source. This field is optional.
  --
  -- Type any
  --    Value of type any can be one of the following:
  --    - A scalar value: number, string or boolean,
  --    - A byte array,
  --    - An array (a list) of any values,
  --    - A map<string, any>.
  , ImmutableLogRecord -> LogAttributes
logRecordAttributes :: LogAttributes
  -- ^ Additional information about the specific event occurrence. Unlike the Resource field, which is fixed for a particular source, Attributes can vary for each occurrence of the event coming from the same source.
  -- Can contain information about the request context (other than Trace Context Fields). The log attribute model MUST support any type, a superset of standard Attribute, to preserve the semantics of structured attributes
  -- emitted by the applications. This field is optional.
  }


{- | Arguments that may be set on LogRecord creation. If observedTimestamp is not set, it will default to the current timestamp.
If context is not specified it will default to the current context. Refer to the documentation of @LogRecord@ for descriptions
of the fields.
-}
data LogRecordArguments = LogRecordArguments
  { LogRecordArguments -> Maybe Timestamp
timestamp :: Maybe Timestamp
  , LogRecordArguments -> Maybe Timestamp
observedTimestamp :: Maybe Timestamp
  , LogRecordArguments -> Maybe Context
context :: Maybe Context
  , LogRecordArguments -> Maybe Text
severityText :: Maybe Text
  , LogRecordArguments -> Maybe SeverityNumber
severityNumber :: Maybe SeverityNumber
  , LogRecordArguments -> AnyValue
body :: AnyValue
  , LogRecordArguments -> HashMap Text AnyValue
attributes :: HashMap Text AnyValue
  }


emptyLogRecordArguments :: LogRecordArguments
emptyLogRecordArguments :: LogRecordArguments
emptyLogRecordArguments =
  LogRecordArguments
    { timestamp :: Maybe Timestamp
timestamp = Maybe Timestamp
forall a. Maybe a
Nothing
    , observedTimestamp :: Maybe Timestamp
observedTimestamp = Maybe Timestamp
forall a. Maybe a
Nothing
    , context :: Maybe Context
context = Maybe Context
forall a. Maybe a
Nothing
    , severityText :: Maybe Text
severityText = Maybe Text
forall a. Maybe a
Nothing
    , severityNumber :: Maybe SeverityNumber
severityNumber = Maybe SeverityNumber
forall a. Maybe a
Nothing
    , body :: AnyValue
body = AnyValue
NullValue
    , attributes :: HashMap Text AnyValue
attributes = HashMap Text AnyValue
forall k v. HashMap k v
H.empty
    }


data SeverityNumber
  = Trace
  | Trace2
  | Trace3
  | Trace4
  | Debug
  | Debug2
  | Debug3
  | Debug4
  | Info
  | Info2
  | Info3
  | Info4
  | Warn
  | Warn2
  | Warn3
  | Warn4
  | Error
  | Error2
  | Error3
  | Error4
  | Fatal
  | Fatal2
  | Fatal3
  | Fatal4
  | Unknown !Int


instance Enum SeverityNumber where
  toEnum :: Int -> SeverityNumber
toEnum Int
1 = SeverityNumber
Trace
  toEnum Int
2 = SeverityNumber
Trace2
  toEnum Int
3 = SeverityNumber
Trace3
  toEnum Int
4 = SeverityNumber
Trace4
  toEnum Int
5 = SeverityNumber
Debug
  toEnum Int
6 = SeverityNumber
Debug2
  toEnum Int
7 = SeverityNumber
Debug3
  toEnum Int
8 = SeverityNumber
Debug4
  toEnum Int
9 = SeverityNumber
Info
  toEnum Int
10 = SeverityNumber
Info2
  toEnum Int
11 = SeverityNumber
Info3
  toEnum Int
12 = SeverityNumber
Info4
  toEnum Int
13 = SeverityNumber
Warn
  toEnum Int
14 = SeverityNumber
Warn2
  toEnum Int
15 = SeverityNumber
Warn3
  toEnum Int
16 = SeverityNumber
Warn4
  toEnum Int
17 = SeverityNumber
Error
  toEnum Int
18 = SeverityNumber
Error2
  toEnum Int
19 = SeverityNumber
Error3
  toEnum Int
20 = SeverityNumber
Error4
  toEnum Int
21 = SeverityNumber
Fatal
  toEnum Int
22 = SeverityNumber
Fatal2
  toEnum Int
23 = SeverityNumber
Fatal3
  toEnum Int
24 = SeverityNumber
Fatal4
  toEnum Int
n = Int -> SeverityNumber
Unknown Int
n


  fromEnum :: SeverityNumber -> Int
fromEnum SeverityNumber
Trace = Int
1
  fromEnum SeverityNumber
Trace2 = Int
2
  fromEnum SeverityNumber
Trace3 = Int
3
  fromEnum SeverityNumber
Trace4 = Int
4
  fromEnum SeverityNumber
Debug = Int
5
  fromEnum SeverityNumber
Debug2 = Int
6
  fromEnum SeverityNumber
Debug3 = Int
7
  fromEnum SeverityNumber
Debug4 = Int
8
  fromEnum SeverityNumber
Info = Int
9
  fromEnum SeverityNumber
Info2 = Int
10
  fromEnum SeverityNumber
Info3 = Int
11
  fromEnum SeverityNumber
Info4 = Int
12
  fromEnum SeverityNumber
Warn = Int
13
  fromEnum SeverityNumber
Warn2 = Int
14
  fromEnum SeverityNumber
Warn3 = Int
15
  fromEnum SeverityNumber
Warn4 = Int
16
  fromEnum SeverityNumber
Error = Int
17
  fromEnum SeverityNumber
Error2 = Int
18
  fromEnum SeverityNumber
Error3 = Int
19
  fromEnum SeverityNumber
Error4 = Int
20
  fromEnum SeverityNumber
Fatal = Int
21
  fromEnum SeverityNumber
Fatal2 = Int
22
  fromEnum SeverityNumber
Fatal3 = Int
23
  fromEnum SeverityNumber
Fatal4 = Int
24
  fromEnum (Unknown Int
n) = Int
n


instance Eq SeverityNumber where
  == :: SeverityNumber -> SeverityNumber -> Bool
(==) = (Int -> Int -> Bool)
-> (SeverityNumber -> Int)
-> SeverityNumber
-> SeverityNumber
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) SeverityNumber -> Int
forall a. Enum a => a -> Int
fromEnum


instance Ord SeverityNumber where
  compare :: SeverityNumber -> SeverityNumber -> Ordering
compare = (Int -> Int -> Ordering)
-> (SeverityNumber -> Int)
-> SeverityNumber
-> SeverityNumber
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SeverityNumber -> Int
forall a. Enum a => a -> Int
fromEnum


toShortName :: SeverityNumber -> Maybe Text
toShortName :: SeverityNumber -> Maybe Text
toShortName SeverityNumber
Trace = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"TRACE"
toShortName SeverityNumber
Trace2 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"TRACE2"
toShortName SeverityNumber
Trace3 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"TRACE3"
toShortName SeverityNumber
Trace4 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"TRACE4"
toShortName SeverityNumber
Debug = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"DEBUG"
toShortName SeverityNumber
Debug2 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"DEBUG2"
toShortName SeverityNumber
Debug3 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"DEBUG3"
toShortName SeverityNumber
Debug4 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"DEBUG4"
toShortName SeverityNumber
Info = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"INFO"
toShortName SeverityNumber
Info2 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"INFO2"
toShortName SeverityNumber
Info3 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"INFO3"
toShortName SeverityNumber
Info4 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"INFO4"
toShortName SeverityNumber
Warn = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"WARN"
toShortName SeverityNumber
Warn2 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"WARN2"
toShortName SeverityNumber
Warn3 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"WARN3"
toShortName SeverityNumber
Warn4 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"WARN4"
toShortName SeverityNumber
Error = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ERROR"
toShortName SeverityNumber
Error2 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ERROR2"
toShortName SeverityNumber
Error3 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ERROR3"
toShortName SeverityNumber
Error4 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ERROR4"
toShortName SeverityNumber
Fatal = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"FATAL"
toShortName SeverityNumber
Fatal2 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"FATAL2"
toShortName SeverityNumber
Fatal3 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"FATAL3"
toShortName SeverityNumber
Fatal4 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"FATAL4"
toShortName (Unknown Int
_) = Maybe Text
forall a. Maybe a
Nothing