Refactored LogRecords to be mutable so that attributes can be modified after creation

api/hs-opentelemetry-api.cabal

@@ -106,6 +106,7 @@ test-suite hs-opentelemetry-api-test
   main-is: Spec.hs
   other-modules:
       OpenTelemetry.BaggageSpec
+      OpenTelemetry.Logging.CoreSpec
       OpenTelemetry.SemanticsConfigSpec
       OpenTelemetry.Trace.SamplerSpec
       OpenTelemetry.Trace.TraceFlagsSpec

api/src/OpenTelemetry/Internal/Common/Types.hs

@@ -1,9 +1,21 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE InstanceSigs #-}
 
-module OpenTelemetry.Internal.Common.Types (InstrumentationLibrary (..)) where
+module OpenTelemetry.Internal.Common.Types (
+  InstrumentationLibrary (..),
+  AnyValue (..),
+  ToValue (..),
+) where
 
+import Data.ByteString (ByteString)
+import Data.Data (Data)
+import qualified Data.HashMap.Strict as H
 import Data.Hashable (Hashable)
+import Data.Int (Int64)
 import Data.String (IsString (fromString))
 import Data.Text (Text)
 import GHC.Generics (Generic)
@@ -59,3 +71,85 @@ instance Hashable InstrumentationLibrary
 instance IsString InstrumentationLibrary where
   fromString :: String -> InstrumentationLibrary
   fromString str = InstrumentationLibrary (fromString str) "" "" emptyAttributes
+
+
+{- | An attribute represents user-provided metadata about a span, link, or event.
+
+ 'Any' values are used in place of 'Standard Attributes' in logs because third-party
+ logs may not conform to the 'Standard Attribute' format.
+
+ Telemetry tools may use this data to support high-cardinality querying, visualization
+ in waterfall diagrams, trace sampling decisions, and more.
+-}
+data AnyValue
+  = TextValue Text
+  | BoolValue Bool
+  | DoubleValue Double
+  | IntValue Int64
+  | ByteStringValue ByteString
+  | ArrayValue [AnyValue]
+  | HashMapValue (H.HashMap Text AnyValue)
+  | NullValue
+  deriving stock (Read, Show, Eq, Ord, Data, Generic)
+  deriving anyclass (Hashable)
+
+
+-- | Create a `TextAttribute` from the string value.
+instance IsString AnyValue where
+  fromString :: String -> AnyValue
+  fromString = TextValue . fromString
+
+
+{- | Convert a Haskell value to an 'Any' value.
+
+ @
+
+ data Foo = Foo
+
+ instance ToValue Foo where
+   toValue Foo = TextValue "Foo"
+
+ @
+-}
+class ToValue a where
+  toValue :: a -> AnyValue
+
+
+instance ToValue Text where
+  toValue :: Text -> AnyValue
+  toValue = TextValue
+
+
+instance ToValue Bool where
+  toValue :: Bool -> AnyValue
+  toValue = BoolValue
+
+
+instance ToValue Double where
+  toValue :: Double -> AnyValue
+  toValue = DoubleValue
+
+
+instance ToValue Int64 where
+  toValue :: Int64 -> AnyValue
+  toValue = IntValue
+
+
+instance ToValue ByteString where
+  toValue :: ByteString -> AnyValue
+  toValue = ByteStringValue
+
+
+instance (ToValue a) => ToValue [a] where
+  toValue :: (ToValue a) => [a] -> AnyValue
+  toValue = ArrayValue . fmap toValue
+
+
+instance (ToValue a) => ToValue (H.HashMap Text a) where
+  toValue :: (ToValue a) => H.HashMap Text a -> AnyValue
+  toValue = HashMapValue . fmap toValue
+
+
+instance ToValue AnyValue where
+  toValue :: AnyValue -> AnyValue
+  toValue = id

api/src/OpenTelemetry/Internal/Logging/Core.hs

@@ -9,6 +9,9 @@ module OpenTelemetry.Internal.Logging.Core (
   getGlobalLoggerProvider,
   makeLogger,
   emitLogRecord,
+  addAttribute,
+  addAttributes,
+  logRecordGetAttributes,
   logDroppedAttributes,
   emitOTelLogRecord,
 ) where
@@ -18,6 +21,7 @@ import Control.Monad (void, when)
 import Control.Monad.Trans
 import Control.Monad.Trans.Maybe
 import Data.Coerce
+import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as H
 import Data.IORef
 import Data.Maybe
@@ -32,6 +36,7 @@ import OpenTelemetry.Context.ThreadLocal
 import OpenTelemetry.Internal.Common.Types
 import OpenTelemetry.Internal.Logging.Types
 import OpenTelemetry.Internal.Trace.Types (SpanContext (..), getSpanContext)
+import OpenTelemetry.LogAttributes (LogAttributes, ToValue)
 import qualified OpenTelemetry.LogAttributes as LA
 import OpenTelemetry.Resource (MaterializedResources, emptyMaterializedResources)
 import Paths_hs_opentelemetry_api (version)
@@ -100,16 +105,12 @@ makeLogger
 makeLogger loggerProvider loggerInstrumentationScope = Logger {..}
 
 
-{- | Emits a LogRecord with properties specified by the passed in Logger and LogRecordArguments.
-If observedTimestamp is not set in LogRecordArguments, it will default to the current timestamp.
-If context is not specified in LogRecordArguments it will default to the current context.
--}
-emitLogRecord
+createImmutableLogRecord
   :: (MonadIO m)
-  => Logger
-  -> LogRecordArguments body
-  -> m (LogRecord body)
-emitLogRecord Logger {..} LogRecordArguments {..} = do
+  => LA.AttributeLimits
+  -> LogRecordArguments
+  -> m ImmutableLogRecord
+createImmutableLogRecord attributeLimits LogRecordArguments {..} = do
   currentTimestamp <- getCurrentTimestamp
   let logRecordObservedTimestamp = fromMaybe currentTimestamp observedTimestamp
 
@@ -121,34 +122,32 @@ emitLogRecord Logger {..} LogRecordArguments {..} = do
 
   let logRecordAttributes =
         LA.addAttributes
-          (loggerProviderAttributeLimits loggerProvider)
+          attributeLimits
           LA.emptyAttributes
           attributes
 
   when (LA.attributesDropped logRecordAttributes > 0) $ void logDroppedAttributes
 
   pure
-    LogRecord
+    ImmutableLogRecord
       { logRecordTimestamp = timestamp
       , logRecordObservedTimestamp
       , logRecordTracingDetails
       , logRecordSeverityNumber = severityNumber
       , logRecordSeverityText = severityText <|> (toShortName =<< severityNumber)
       , logRecordBody = body
-      , logRecordResource = loggerProviderResource loggerProvider
-      , logRecordInstrumentationScope = loggerInstrumentationScope
       , logRecordAttributes
       }
 
 
 -- | WARNING: this function should only be used to emit logs from the hs-opentelemetry-api library. DO NOT USE this function in any other context.
-logDroppedAttributes :: (MonadIO m) => m (LogRecord Text)
+logDroppedAttributes :: (MonadIO m) => m ReadWriteLogRecord
 logDroppedAttributes = emitOTelLogRecord H.empty Warn "At least 1 attribute was discarded due to the attribute limits set in the logger provider."
 
 
 -- | WARNING: this function should only be used to emit logs from the hs-opentelemetry-api library. DO NOT USE this function in any other context.
-emitOTelLogRecord :: (MonadIO m) => H.HashMap Text LA.AnyValue -> SeverityNumber -> Text -> m (LogRecord Text)
-emitOTelLogRecord attrs severity body = do
+emitOTelLogRecord :: (MonadIO m) => H.HashMap Text LA.AnyValue -> SeverityNumber -> Text -> m ReadWriteLogRecord
+emitOTelLogRecord attrs severity bodyText = do
   glp <- getGlobalLoggerProvider
   let gl =
         makeLogger glp $
@@ -160,7 +159,91 @@ emitOTelLogRecord attrs severity body = do
             }
 
   emitLogRecord gl $
-    (emptyLogRecordArguments body)
+    emptyLogRecordArguments
       { severityNumber = Just severity
+      , body = toValue bodyText
       , attributes = attrs
       }
+
+
+{- | Emits a LogRecord with properties specified by the passed in Logger and LogRecordArguments.
+If observedTimestamp is not set in LogRecordArguments, it will default to the current timestamp.
+If context is not specified in LogRecordArguments it will default to the current context.
+-}
+emitLogRecord
+  :: (MonadIO m)
+  => Logger
+  -> LogRecordArguments
+  -> m ReadWriteLogRecord
+emitLogRecord l args = do
+  ilr <- createImmutableLogRecord (loggerProviderAttributeLimits $ loggerProvider l) args
+  liftIO $ mkReadWriteLogRecord l ilr
+
+
+{- | Add an attribute to a @LogRecord@.
+
+This is not an atomic modification
+
+As an application developer when you need to record an attribute first consult existing semantic conventions for Resources, Spans, and Metrics. If an appropriate name does not exists you will need to come up with a new name. To do that consider a few options:
+
+The name is specific to your company and may be possibly used outside the company as well. To avoid clashes with names introduced by other companies (in a distributed system that uses applications from multiple vendors) it is recommended to prefix the new name by your company’s reverse domain name, e.g. 'com.acme.shopname'.
+
+The name is specific to your application that will be used internally only. If you already have an internal company process that helps you to ensure no name clashes happen then feel free to follow it. Otherwise it is recommended to prefix the attribute name by your application name, provided that the application name is reasonably unique within your organization (e.g. 'myuniquemapapp.longitude' is likely fine). Make sure the application name does not clash with an existing semantic convention namespace.
+
+The name may be generally applicable to applications in the industry. In that case consider submitting a proposal to this specification to add a new name to the semantic conventions, and if necessary also to add a new namespace.
+
+It is recommended to limit names to printable Basic Latin characters (more precisely to 'U+0021' .. 'U+007E' subset of Unicode code points), although the Haskell OpenTelemetry specification DOES provide full Unicode support.
+
+Attribute names that start with 'otel.' are reserved to be defined by OpenTelemetry specification. These are typically used to express OpenTelemetry concepts in formats that don’t have a corresponding concept.
+
+For example, the 'otel.library.name' attribute is used to record the instrumentation library name, which is an OpenTelemetry concept that is natively represented in OTLP, but does not have an equivalent in other telemetry formats and protocols.
+
+Any additions to the 'otel.*' namespace MUST be approved as part of OpenTelemetry specification.
+-}
+addAttribute :: (IsReadWriteLogRecord r, MonadIO m, ToValue a) => r -> Text -> a -> m ()
+addAttribute lr k v =
+  let attributeLimits = readLogRecordAttributeLimits lr
+  in liftIO $
+      modifyLogRecord
+        lr
+        ( \ilr@ImmutableLogRecord {logRecordAttributes} ->
+            ilr
+              { logRecordAttributes =
+                  LA.addAttribute
+                    attributeLimits
+                    logRecordAttributes
+                    k
+                    v
+              }
+        )
+
+
+{- | A convenience function related to 'addAttribute' that adds multiple attributes to a @LogRecord@ at the same time.
+
+This function may be slightly more performant than repeatedly calling 'addAttribute'.
+
+This is not an atomic modification
+-}
+addAttributes :: (IsReadWriteLogRecord r, MonadIO m, ToValue a) => r -> HashMap Text a -> m ()
+addAttributes lr attrs =
+  let attributeLimits = readLogRecordAttributeLimits lr
+  in liftIO $
+      modifyLogRecord
+        lr
+        ( \ilr@ImmutableLogRecord {logRecordAttributes} ->
+            ilr
+              { logRecordAttributes =
+                  LA.addAttributes
+                    attributeLimits
+                    logRecordAttributes
+                    attrs
+              }
+        )
+
+
+{- | This can be useful for pulling data for attributes and
+ using it to copy / otherwise use the data to further enrich
+ instrumentation.
+-}
+logRecordGetAttributes :: (IsReadableLogRecord r, MonadIO m) => r -> m LogAttributes
+logRecordGetAttributes lr = liftIO $ logRecordAttributes <$> readLogRecord lr