Refactored LogRecords to be mutable so that attributes can be modifie…

…d after creation
iand675 · Jun 21, 2024 · 4df5c2e · 4df5c2e
1 parent 8e35e04
commit 4df5c2e
Show file tree

Hide file tree

Showing 7 changed files with 225 additions and 19 deletions.
diff --git a/api/hs-opentelemetry-api.cabal b/api/hs-opentelemetry-api.cabal
@@ -104,6 +104,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

diff --git a/api/src/OpenTelemetry/Internal/Logging/Types.hs b/api/src/OpenTelemetry/Internal/Logging/Types.hs
@@ -5,21 +5,22 @@ module OpenTelemetry.Internal.Logging.Types (
   LoggerProvider (..),
   Logger (..),
   LogRecord (..),
+  ImmutableLogRecord (..),
   LogRecordArguments (..),
   mkSeverityNumber,
   shortName,
   severityInt,
 ) where
 
 import qualified Data.HashMap.Strict as H
+import Data.IORef (IORef)
 import Data.Int (Int64)
 import Data.Text (Text)
-import OpenTelemetry.Attributes (AttributeLimits)
 import OpenTelemetry.Common (Timestamp, TraceFlags)
-import OpenTelemetry.Context.Types
+import OpenTelemetry.Context.Types (Context)
 import OpenTelemetry.Internal.Common.Types (InstrumentationLibrary)
 import OpenTelemetry.Internal.Trace.Id (SpanId, TraceId)
-import OpenTelemetry.LogAttributes (AnyValue, LogAttributes)
+import OpenTelemetry.LogAttributes (AnyValue, AttributeLimits, LogAttributes)
 import OpenTelemetry.Resource (MaterializedResources)
 
 
@@ -28,6 +29,7 @@ data LoggerProvider = LoggerProvider
   { loggerProviderResource :: MaterializedResources
   , loggerProviderAttributeLimits :: AttributeLimits
   }
+  deriving (Show, Eq)
 
 
 {- | @LogRecords@ can be created from @Loggers@. @Logger@s are uniquely identified by the @libraryName@, @libraryVersion@, @schemaUrl@ fields of @InstrumentationLibrary@.
@@ -44,7 +46,10 @@ data Logger = Logger
 {- | 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.
 -}
-data LogRecord body = LogRecord
+data LogRecord a = LogRecord (IORef (ImmutableLogRecord a))
+
+
+data ImmutableLogRecord body = ImmutableLogRecord
   { 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.
   , logRecordObservedTimestamp :: Timestamp
@@ -113,6 +118,7 @@ data LogRecord body = LogRecord
   -- ^ 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.
+  , logRecordLogger :: Logger
   }
   deriving (Functor)
 

diff --git a/api/src/OpenTelemetry/LogAttributes.hs b/api/src/OpenTelemetry/LogAttributes.hs
@@ -16,6 +16,10 @@ module OpenTelemetry.LogAttributes (
   AnyValue (..),
   ToValue (..),
 
+  -- * Attribute limits
+  AttributeLimits (..),
+  defaultAttributeLimits,
+
   -- * unsafe utilities
   unsafeLogAttributesFromListIgnoringLimits,
   unsafeMergeLogAttributesIgnoringLimits,
@@ -30,7 +34,7 @@ import Data.String (IsString (..))
 import Data.Text (Text)
 import qualified Data.Text as T
 import GHC.Generics (Generic)
-import OpenTelemetry.Attributes (AttributeLimits (..))
+import OpenTelemetry.Attributes (AttributeLimits (..), defaultAttributeLimits)
 
 
 data LogAttributes = LogAttributes

diff --git a/api/src/OpenTelemetry/Logging/Core.hs b/api/src/OpenTelemetry/Logging/Core.hs
@@ -22,24 +22,29 @@ module OpenTelemetry.Logging.Core (
   shortName,
   severityInt,
   emitLogRecord,
+  addAttribute,
+  addAttributes,
+  logRecordGetAttributes,
 ) where
 
 import Control.Applicative
 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
+import Data.Text (Text)
 import GHC.IO (unsafePerformIO)
-import OpenTelemetry.Attributes (AttributeLimits)
 import OpenTelemetry.Common
 import OpenTelemetry.Context
 import OpenTelemetry.Context.ThreadLocal
 import OpenTelemetry.Internal.Common.Types
 import OpenTelemetry.Internal.Logging.Types
 import OpenTelemetry.Internal.Trace.Types
-import OpenTelemetry.LogAttributes
+import OpenTelemetry.LogAttributes (ToValue)
+import qualified OpenTelemetry.LogAttributes as A
 import OpenTelemetry.Resource (MaterializedResources, emptyMaterializedResources)
 import System.Clock
 
@@ -50,7 +55,7 @@ getCurrentTimestamp = liftIO $ coerce @(IO TimeSpec) @(IO Timestamp) $ getTime R
 
 data LoggerProviderOptions = LoggerProviderOptions
   { loggerProviderOptionsResource :: MaterializedResources
-  , loggerProviderOptionsAttributeLimits :: AttributeLimits
+  , loggerProviderOptionsAttributeLimits :: A.AttributeLimits
   }
 
 
@@ -62,6 +67,7 @@ emptyLoggerProviderOptions :: LoggerProviderOptions
 emptyLoggerProviderOptions =
   LoggerProviderOptions
     { loggerProviderOptionsResource = emptyMaterializedResources
+    , loggerProviderOptionsAttributeLimits = A.defaultAttributeLimits
     }
 
 
@@ -70,7 +76,11 @@ emptyLoggerProviderOptions =
  You should generally use @getGlobalLoggerProvider@ for most applications.
 -}
 createLoggerProvider :: LoggerProviderOptions -> LoggerProvider
-createLoggerProvider LoggerProviderOptions {..} = LoggerProvider {loggerProviderResource = loggerProviderOptionsResource}
+createLoggerProvider LoggerProviderOptions {..} =
+  LoggerProvider
+    { loggerProviderResource = loggerProviderOptionsResource
+    , loggerProviderAttributeLimits = loggerProviderOptionsAttributeLimits
+    }
 
 
 globalLoggerProvider :: IORef LoggerProvider
@@ -101,16 +111,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
+  -> m (ImmutableLogRecord body)
+createImmutableLogRecord logger@Logger {..} LogRecordArguments {..} = do
   currentTimestamp <- getCurrentTimestamp
   let logRecordObservedTimestamp = fromMaybe currentTimestamp observedTimestamp
 
@@ -121,7 +127,7 @@ emitLogRecord Logger {..} LogRecordArguments {..} = do
     pure (traceId, spanId, traceFlags)
 
   pure
-    LogRecord
+    ImmutableLogRecord
       { logRecordTimestamp = timestamp
       , logRecordObservedTimestamp
       , logRecordTracingDetails
@@ -131,8 +137,87 @@ emitLogRecord Logger {..} LogRecordArguments {..} = do
       , logRecordResource = loggerProviderResource loggerProvider
       , logRecordInstrumentationScope = loggerInstrumentationScope
       , logRecordAttributes =
-          addAttributes
+          A.addAttributes
             (loggerProviderAttributeLimits loggerProvider)
-            emptyAttributes
+            A.emptyAttributes
             attributes
+      , logRecordLogger = 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
+  :: (MonadIO m)
+  => Logger
+  -> LogRecordArguments body
+  -> m (LogRecord body)
+emitLogRecord l args = do
+  ilr <- createImmutableLogRecord l args
+  lr <- liftIO $ newIORef ilr
+  pure $ LogRecord lr
+
+
+{- | Add an attribute to a @LogRecord@.
+
+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 :: (MonadIO m, ToValue a) => LogRecord body -> Text -> a -> m ()
+addAttribute (LogRecord lr) k v =
+  liftIO $
+    modifyIORef'
+      lr
+      ( \ilr@ImmutableLogRecord {logRecordAttributes, logRecordLogger} ->
+          ilr
+            { logRecordAttributes =
+                A.addAttribute
+                  (loggerProviderAttributeLimits $ loggerProvider logRecordLogger)
+                  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'.
+-}
+addAttributes :: (MonadIO m, ToValue a) => LogRecord body -> HashMap Text a -> m ()
+addAttributes (LogRecord lr) attrs =
+  liftIO $
+    modifyIORef'
+      lr
+      ( \ilr@ImmutableLogRecord {logRecordAttributes, logRecordLogger} ->
+          ilr
+            { logRecordAttributes =
+                A.addAttributes
+                  (loggerProviderAttributeLimits $ loggerProvider logRecordLogger)
+                  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 :: (MonadIO m) => LogRecord a -> m A.LogAttributes
+logRecordGetAttributes (LogRecord lr) = liftIO $ logRecordAttributes <$> readIORef lr
diff --git a/api/src/OpenTelemetry/Resource.hs b/api/src/OpenTelemetry/Resource.hs
@@ -176,6 +176,7 @@ data MaterializedResources = MaterializedResources
   { materializedResourcesSchema :: Maybe String
   , materializedResourcesAttributes :: Attributes
   }
+  deriving (Show, Eq)
 
 
 {- | A placeholder for 'MaterializedResources' when no resource information is

diff --git a/api/test/OpenTelemetry/Logging/CoreSpec.hs b/api/test/OpenTelemetry/Logging/CoreSpec.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module OpenTelemetry.Logging.CoreSpec where
+
+import qualified Data.HashMap.Strict as H
+import Data.IORef
+import qualified OpenTelemetry.Attributes as A
+import OpenTelemetry.Internal.Logging.Types
+import qualified OpenTelemetry.LogAttributes as LA
+import OpenTelemetry.Logging.Core
+import OpenTelemetry.Resource
+import OpenTelemetry.Resource.OperatingSystem
+import Test.Hspec
+
+
+spec :: Spec
+spec = describe "Core" $ do
+  describe "getGlobalLoggerProvider" $ do
+    it "Returns a no-op LoggerProvider when not initialized" $ do
+      LoggerProvider {..} <- getGlobalLoggerProvider
+      loggerProviderResource `shouldBe` emptyMaterializedResources
+      loggerProviderAttributeLimits `shouldBe` LA.defaultAttributeLimits
+  describe "setGlobalLoggerProvider" $ do
+    it "works" $ do
+      lp <-
+        createLoggerProvider $
+          LoggerProviderOptions
+            { loggerProviderOptionsResource =
+                materializeResources $
+                  toResource
+                    OperatingSystem
+                      { osType = "exampleOs"
+                      , osDescription = Nothing
+                      , osName = Nothing
+                      , osVersion = Nothing
+                      }
+            , loggerProviderOptionsAttributeLimits =
+                LA.AttributeLimits
+                  { attributeCountLimit = Just 50
+                  , attributeLengthLimit = Just 50
+                  }
+            }
+      setGlobalLoggerProvider lp
+      glp <- getGlobalLoggerProvider
+      glp `shouldBe` lp
+  describe "addAttribute" $ do
+    it "works" $ do
+      lp <- getGlobalLoggerProvider
+      let l = makeLogger lp InstrumentationLibrary {libraryName = "exampleLibrary", libraryVersion = "", librarySchemaUrl = "", libraryAttributes = A.emptyAttributes}
+      lr <-
+        emitLogRecord
+          l
+          LogRecordArguments
+            { timestamp = Nothing
+            , observedTimestamp = Nothing
+            , context = Nothing
+            , severityText = Nothing
+            , severityNumber = Nothing
+            , body = Nothing
+            , attributes =
+                H.fromList
+                  [ ("something", "a thing")
+                  ]
+            }
+      addAttribute lr "anotherThing" ("another thing" :: LA.AnyValue)
+
+      (_, attrs) <- LA.getAttributes <$> logRecordGetAttributes lr
+
+      attrs
+        `shouldBe` H.fromList
+          [ ("anotherThing", "another thing")
+          , ("something", "a thing")
+          ]
+  describe "addAttributes" $ do
+    it "works" $ do
+      lp <- getGlobalLoggerProvider
+      let l = makeLogger lp InstrumentationLibrary {libraryName = "exampleLibrary", libraryVersion = "", librarySchemaUrl = "", libraryAttributes = A.emptyAttributes}
+      lr <-
+        emitLogRecord
+          l
+          LogRecordArguments
+            { timestamp = Nothing
+            , observedTimestamp = Nothing
+            , context = Nothing
+            , severityText = Nothing
+            , severityNumber = Nothing
+            , body = Nothing
+            , attributes =
+                H.fromList
+                  [ ("something", "a thing")
+                  ]
+            }
+      addAttributes lr $
+        H.fromList
+          [ ("anotherThing", "another thing" :: LA.AnyValue)
+          , ("twoThing", "the second another thing")
+          ]
+
+      (_, attrs) <- LA.getAttributes <$> logRecordGetAttributes lr
+
+      attrs
+        `shouldBe` H.fromList
+          [ ("anotherThing", "another thing")
+          , ("something", "a thing")
+          , ("twoThing", "the second another thing")
+          ]
diff --git a/api/test/Spec.hs b/api/test/Spec.hs
@@ -13,6 +13,7 @@ import OpenTelemetry.Attributes (lookupAttribute)
 
 import qualified OpenTelemetry.BaggageSpec as Baggage
 import OpenTelemetry.Context
+import qualified OpenTelemetry.Logging.CoreSpec as CoreSpec
 import qualified OpenTelemetry.SemanticsConfigSpec as SemanticsConfigSpec
 import OpenTelemetry.Trace.Core
 import qualified OpenTelemetry.Trace.SamplerSpec as Sampler
@@ -56,3 +57,4 @@ main = hspec $ do
   Sampler.spec
   TraceFlags.spec
   SemanticsConfigSpec.spec
+  CoreSpec.spec