From 608b6d2765d4088ce299fd4172490851a19cdf88 Mon Sep 17 00:00:00 2001 From: Kazuki Okamoto Date: Thu, 28 Mar 2024 13:57:58 +0900 Subject: [PATCH] =?UTF-8?q?=E3=83=95=E3=83=83=E3=82=AF=E7=89=88=20herp-log?= =?UTF-8?q?ger?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- api/src/OpenTelemetry/Resource.hs | 10 + cabal.project | 3 +- .../herp-logger/herp-logger-example.cabal | 40 ++++ examples/herp-logger/main.hs | 34 ++++ hie.yaml | 3 + ...-instrumentation-herp-logger-datadog.cabal | 4 +- .../Instrumentation/Herp/Logger/Datadog.hs | 171 ++---------------- sdk/src/OpenTelemetry/Trace.hs | 1 + 8 files changed, 107 insertions(+), 159 deletions(-) create mode 100644 examples/herp-logger/herp-logger-example.cabal create mode 100644 examples/herp-logger/main.hs diff --git a/api/src/OpenTelemetry/Resource.hs b/api/src/OpenTelemetry/Resource.hs index d209ffe5..c2f07199 100644 --- a/api/src/OpenTelemetry/Resource.hs +++ b/api/src/OpenTelemetry/Resource.hs @@ -29,6 +29,8 @@ module OpenTelemetry.Resource ( Resource, (.=), (.=?), + (.=$), + (.=$?), ResourceMerge, mergeResources, @@ -91,6 +93,14 @@ k .= v = Just (k, toAttribute v) k .=? mv = (\k' v -> (k', toAttribute v)) k <$> mv +(.=$) :: (ToAttribute a) => Key a -> a -> Maybe (Text, Attribute) +Key k .=$ v = Just (k, toAttribute v) + + +(.=$?) :: (ToAttribute a) => Key a -> Maybe a -> Maybe (Text, Attribute) +Key k .=$? mv = (\k' v -> (k', toAttribute v)) k <$> mv + + instance Semigroup (Resource s) where (<>) (Resource l) (Resource r) = Resource (unsafeMergeAttributesIgnoringLimits l r) diff --git a/cabal.project b/cabal.project index 93e01593..c989d6c5 100644 --- a/cabal.project +++ b/cabal.project @@ -6,6 +6,7 @@ packages: , examples/aws-s3 , examples/grpc-echo , examples/hdbc-mysql + , examples/herp-logger , examples/http-server , examples/yesod-minimal , examples/yesod-subsite @@ -72,7 +73,7 @@ source-repository-package source-repository-package type: git location: https://github.com/herp-inc/herp-logger - tag: v0.3 + tag: 99ebe35339d973d6d47f1c307cb11da7ca42206e allow-newer: http-api-data:base diff --git a/examples/herp-logger/herp-logger-example.cabal b/examples/herp-logger/herp-logger-example.cabal new file mode 100644 index 00000000..91564ec9 --- /dev/null +++ b/examples/herp-logger/herp-logger-example.cabal @@ -0,0 +1,40 @@ +cabal-version: 3.4 + +name: herp-logger-example +version: 0.0.0 +build-type: Simple + +common common + ghc-options: -threaded + -with-rtsopts=-N + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-exported-signatures + -Wmissing-home-modules + -Wmissing-export-lists + -Wmonomorphism-restriction + -Wno-name-shadowing + -Wpartial-fields + -Wredundant-constraints + -Wunused-packages + if impl(ghc >= 9.0) + ghc-options: -Winvalid-haddock + if impl(ghc >= 9.2) + ghc-options: -Wmissing-kind-signatures + -Woperator-whitespace + -Wredundant-bang-patterns + default-language: Haskell2010 + +executable herp-logger-example + import: common + main-is: main.hs + hs-source-dirs: . + build-depends: base, + herp-logger, + hs-opentelemetry-sdk, + hs-opentelemetry-instrumentation-herp-logger-datadog, + hs-opentelemetry-vendor-datadog diff --git a/examples/herp-logger/main.hs b/examples/herp-logger/main.hs new file mode 100644 index 00000000..62264b14 --- /dev/null +++ b/examples/herp-logger/main.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} + +import Control.Exception (bracket) +import OpenTelemetry.Trace +import OpenTelemetry.Resource +import Herp.Logger +import OpenTelemetry.Instrumentation.Herp.Logger.Datadog +import OpenTelemetry.Vendor.Datadog + +main :: IO () +main = do + let + resource :: Resource 'Nothing + resource = + mkResource + [ envKey .=$ "test" + , serviceKey .=$ "hs-opentelemetry" + , versionKey .=$ "0" + ] + bracket + ( do + (processors, options) <- getTracerProviderInitializationOptions' resource + createTracerProvider processors options + ) + shutdownTracerProvider + $ \tracerProvider -> + let loggerConfig = appendHooksToConfig tracerProvider defaultLoggerConfig + in do + withLogger loggerConfig $ \logger -> do + let tracer = makeTracer tracerProvider "main" tracerOptions + inSpan' tracer "main" defaultSpanArguments $ \span -> do + addAttributeByKey span envKey "test" + logIO logger "log" diff --git a/hie.yaml b/hie.yaml index 9681f3ec..7089ae59 100644 --- a/hie.yaml +++ b/hie.yaml @@ -55,6 +55,9 @@ cradle: - path: "examples/hdbc-mysql/main.hs" component: "hdbc-mysql-example:exe:hdbc-mysql-example" + - path: "examples/herp-logger/main.hs" + component: "herp-logger-example:exe:herp-logger-example" + - path: "examples/http-server/main.hs" component: "http-server:exe:http-server" diff --git a/instrumentation/herp-logger-datadog/hs-opentelemetry-instrumentation-herp-logger-datadog.cabal b/instrumentation/herp-logger-datadog/hs-opentelemetry-instrumentation-herp-logger-datadog.cabal index d9ba955b..d0189f0a 100644 --- a/instrumentation/herp-logger-datadog/hs-opentelemetry-instrumentation-herp-logger-datadog.cabal +++ b/instrumentation/herp-logger-datadog/hs-opentelemetry-instrumentation-herp-logger-datadog.cabal @@ -16,13 +16,13 @@ library import: common hs-source-dirs: src exposed-modules: OpenTelemetry.Instrumentation.Herp.Logger.Datadog + other-modules: Paths_hs_opentelemetry_instrumentation_herp_logger_datadog + autogen-modules: Paths_hs_opentelemetry_instrumentation_herp_logger_datadog build-depends: hs-opentelemetry-api, hs-opentelemetry-semantic-conventions, hs-opentelemetry-vendor-datadog, aeson, herp-logger, - monad-logger, - mtl, text, ghc-options: -Wcompat -Wno-name-shadowing diff --git a/instrumentation/herp-logger-datadog/src/OpenTelemetry/Instrumentation/Herp/Logger/Datadog.hs b/instrumentation/herp-logger-datadog/src/OpenTelemetry/Instrumentation/Herp/Logger/Datadog.hs index bbed993a..5194a676 100644 --- a/instrumentation/herp-logger-datadog/src/OpenTelemetry/Instrumentation/Herp/Logger/Datadog.hs +++ b/instrumentation/herp-logger-datadog/src/OpenTelemetry/Instrumentation/Herp/Logger/Datadog.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} @@ -15,58 +13,18 @@ Datadog functionality about connections of Traces and Logs is described in This logger requires 'Otel.Tracer' to retrieve OpenTelemetry context additionally. -} module OpenTelemetry.Instrumentation.Herp.Logger.Datadog ( - (Orig..=), - Logger (..), - HasLogger (..), - ToLogger (..), - Orig.LogLevel (..), - Orig.LoggerConfig (..), - newLogger, - withLogger, - makeLogger, - Orig.defaultLoggerConfig, - logM, - logOtherM, - logDebugM, - logInfoM, - logNoticeM, - logWarnM, - logErrorM, - logCritM, - logAlertM, - logEmergM, - logIO, - Orig.urgentLog, - flush, - - -- * Payload - Orig.Payload, - Orig.level, - Orig.message, - Orig.object, - Orig.messageString, - Orig.messageShow, - Orig.messageException, - - -- * monad-logger - runLoggingT, - toLoggerIO, + appendHooksToConfig, ) where import Control.Applicative (Alternative ((<|>))) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import qualified Control.Monad.Logger as ML -import Control.Monad.Reader.Class (MonadReader (ask), asks) +import Control.Monad.IO.Class (MonadIO) import qualified Data.Aeson.KeyMap as Aeson import qualified Data.Aeson.Types as Aeson import Data.Maybe (maybeToList) import Data.Text (Text) import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import GHC.Generics (Generic) -import Herp.Logger ((.=)) +import Data.Version (showVersion) import qualified Herp.Logger as Orig -import qualified Herp.Logger.LogLevel as Orig import qualified Herp.Logger.Payload as Orig import qualified OpenTelemetry.Attributes as Otel import qualified OpenTelemetry.Attributes.Map as Otel @@ -76,123 +34,24 @@ import qualified OpenTelemetry.Resource as Otel import qualified OpenTelemetry.SemanticConventions as Otel import qualified OpenTelemetry.Trace.Core as Otel import qualified OpenTelemetry.Vendor.Datadog as Datadog +import Paths_hs_opentelemetry_instrumentation_herp_logger_datadog (version) -data Logger = Logger {original :: Orig.Logger, tracer :: Otel.Tracer} deriving stock (Generic) - - -makeLogger :: Orig.Logger -> Otel.TracerProvider -> Logger -makeLogger original provider = - Logger - { original - , tracer = Otel.makeTracer provider "hs-opentelemetry-instrumentation-herp-logger-datadog" Otel.tracerOptions - } - - -newLogger :: Orig.LoggerConfig -> Otel.TracerProvider -> IO Logger -newLogger config provider = do - original <- Orig.newLogger config - pure $ makeLogger original provider - - -withLogger :: Orig.LoggerConfig -> Otel.TracerProvider -> (Logger -> IO a) -> IO a -withLogger config provider f = - Orig.withLogger config $ \original -> f $ makeLogger original provider - - -class HasLogger a where - toLogger :: a -> Logger - - -instance HasLogger Logger where - toLogger = id +appendHooksToConfig :: Otel.TracerProvider -> Orig.LoggerConfig -> Orig.LoggerConfig +appendHooksToConfig provider config@Orig.LoggerConfig {Orig.hooks} = config {Orig.hooks = hooks {Orig.logHook = logHook provider . Orig.logHook hooks}} -instance Orig.HasLogger Logger where - toLogger = original . toLogger - - -instance Otel.HasTracer Logger where - tracerL f Logger {tracer, original} = (\tracer -> Logger {original, tracer}) <$> f tracer - - --- | This wrapper is intended to be used with /deriving via/. -newtype ToLogger a = ToLogger {getToLogger :: a} - - -instance HasLogger a => Orig.HasLogger (ToLogger a) where - toLogger = original . toLogger . getToLogger - - -logIO :: MonadIO m => Logger -> Orig.Payload -> m () -logIO Logger {original = logger, tracer} payload = do +logHook :: Otel.TracerProvider -> (Orig.Logger -> Orig.Payload -> IO ()) -> Orig.Logger -> Orig.Payload -> IO () +logHook provider hook logger payload = do + let + tracer = + Otel.makeTracer + provider + (Otel.InstrumentationLibrary "hs-opentelemetry-instrumentation-herp-logger-datadog" $ Text.pack $ showVersion version) + Otel.tracerOptions context <- Otel.getContext payload' <- datadogPayload (Otel.getTracerTracerProvider tracer) $ Otel.lookupSpan context - Orig.logIO logger (payload' <> payload) -{-# INLINE logIO #-} - - -logM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logM payload = do - logger <- toLogger <$> ask - logIO logger payload -{-# INLINE logM #-} - - -logOtherM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.LogLevel -> Orig.Payload -> m () -logOtherM logLevel payload = logM $ Orig.level logLevel <> payload - - -logDebugM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logDebugM = logOtherM Orig.Debug - - -logInfoM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logInfoM = logOtherM Orig.Informational - - -logNoticeM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logNoticeM = logOtherM Orig.Notice - - -logWarnM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logWarnM = logOtherM Orig.Warning - - -logErrorM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logErrorM = logOtherM Orig.Error - - -logCritM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logCritM = logOtherM Orig.Critical - - -logAlertM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logAlertM = logOtherM Orig.Alert - - -logEmergM :: (MonadIO m, MonadReader r m, HasLogger r) => Orig.Payload -> m () -logEmergM = logOtherM Orig.Emergency - - -flush :: (MonadReader r m, HasLogger r, MonadIO m) => m () -flush = asks toLogger >>= liftIO . Orig.loggerFlush . original - - -runLoggingT :: Logger -> ML.LoggingT m a -> m a -runLoggingT logger (ML.LoggingT run) = run $ toLoggerIO logger - - -toLoggerIO :: Logger -> ML.Loc -> ML.LogSource -> ML.LogLevel -> ML.LogStr -> IO () -toLoggerIO logger loc logSrc lv logStr = do - let msg = Text.decodeUtf8 $ ML.fromLogStr $ ML.defaultLogStr loc logSrc lv logStr - logIO - logger - [ Orig.message msg - , case Orig.convertLogLevel lv of - Right x -> Orig.level x - Left other -> [#warn, "level" .= other] - ] + hook logger $ payload' <> payload datadogPayload :: MonadIO m => Otel.TracerProvider -> Maybe Otel.Span -> m Orig.Payload diff --git a/sdk/src/OpenTelemetry/Trace.hs b/sdk/src/OpenTelemetry/Trace.hs index 73c91f65..fbc1ed2a 100644 --- a/sdk/src/OpenTelemetry/Trace.hs +++ b/sdk/src/OpenTelemetry/Trace.hs @@ -118,6 +118,7 @@ module OpenTelemetry.Trace ( inSpan', updateName, addAttribute, + addAttributeByKey, addAttributes, recordException, setStatus,