packages feed

hs-opentelemetry-instrumentation-katip (empty) → 1.0.0.0

raw patch · 5 files changed

+357/−0 lines, 5 filesdep +aesondep +basedep +hs-opentelemetry-api

Dependencies added: aeson, base, hs-opentelemetry-api, hs-opentelemetry-exporter-in-memory, hs-opentelemetry-instrumentation-katip, hs-opentelemetry-sdk, hs-opentelemetry-semantic-conventions, hspec, katip, template-haskell, text, unordered-containers, vector

Files

+ ChangeLog.md view
@@ -0,0 +1,15 @@+# Changelog for hs-opentelemetry-instrumentation-katip++## 1.0.0.0 - 2026-05-29++- Promoted to 1.0.0.0 for the hs-opentelemetry 1.0 release.++## 0.1.0.0++- Initial release.+- Provides a Katip `Scribe` that forwards log items to the OpenTelemetry Logs pipeline.+- Severity mapping: `DebugS`→`Debug`, `InfoS`→`Info`, `WarningS`→`Warn`,+  `ErrorS`→`Error`, `CriticalS`/`AlertS`/`EmergencyS`→`Fatal` variants.+- Structured Katip payloads serialised as `log.payload.*` attributes.+- Standard OTel attributes emitted: `thread.id`, `server.address`, `process.pid`,+  `code.filepath`, `code.function.name`, `code.lineno`, `katip.namespace`.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ian Duncan (c) 2021-2026++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ian Duncan nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ hs-opentelemetry-instrumentation-katip.cabal view
@@ -0,0 +1,58 @@+cabal-version: 2.0+name:               hs-opentelemetry-instrumentation-katip+version:            1.0.0.0+synopsis:           Bridge Katip structured logging to OpenTelemetry Logs+description:+  Provides a Katip Scribe that forwards structured log items to the+  OpenTelemetry Logs pipeline with automatic trace correlation. Katip's+  rich structured payloads (namespaces, JSON context, source locations)+  are preserved as OTel log record attributes.+category:           OpenTelemetry, Logging+homepage:           https://github.com/iand675/hs-opentelemetry#readme+bug-reports:        https://github.com/iand675/hs-opentelemetry/issues+author:             Ian Duncan+maintainer:         ian@iankduncan.com+copyright:          2024-2026 Ian Duncan, Mercury Technologies+license:            BSD3+license-file:       LICENSE+build-type:         Simple+extra-doc-files:    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/iand675/hs-opentelemetry++library+  exposed-modules:+      OpenTelemetry.Instrumentation.Katip+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      aeson+    , base >=4.7 && <5+    , hs-opentelemetry-api ^>= 1.0+    , hs-opentelemetry-semantic-conventions >= 1.40 && < 2+    , katip >=0.8 && <0.9+    , template-haskell+    , text+    , unordered-containers+  default-language: Haskell2010++test-suite hs-opentelemetry-instrumentation-katip-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , hs-opentelemetry-api ^>= 1.0+    , hs-opentelemetry-exporter-in-memory ^>= 1.0+    , hs-opentelemetry-instrumentation-katip ^>= 1.0+    , hs-opentelemetry-sdk ^>= 1.0+    , hspec+    , katip >=0.8 && <0.9+    , text+    , vector+  default-language: Haskell2010
+ src/OpenTelemetry/Instrumentation/Katip.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++{- |+Module      : OpenTelemetry.Instrumentation.Katip+Copyright   : (c) Ian Duncan, 2021-2026+License     : BSD-3+Description : Bridge Katip structured logging to OpenTelemetry Logs+Stability   : experimental++Provides a Katip 'K.Scribe' that forwards structured log items to the+OpenTelemetry Logs pipeline. Because Katip items carry rich structured data+(JSON payloads, namespaces, thread IDs, source locations), the bridge+preserves all of it as OTel log record attributes.++* __Trace correlation is automatic__: log records emitted inside an+  'OpenTelemetry.Trace.Core.inSpan' block carry the active trace\/span IDs.++* __Structured payloads preserved__: the 'K.LogItem' payload is serialized+  to JSON and stored under @log.payload.*@ attributes.++* __Severity mapping__: Katip 'K.Severity' maps naturally to OTel severity+  (DebugS→Debug, InfoS→Info, WarningS→Warn, ErrorS→Error,+  CriticalS→Fatal, etc.).++= Usage++@+import qualified Katip as K+import OpenTelemetry.Log.Core+import OpenTelemetry.Instrumentation.Katip++main :: IO ()+main = do+  lp <- getGlobalLoggerProvider+  let logger = makeLogger lp (instrumentationLibrary \"my-app\" \"1.0.0\")+  scribe <- makeOTelScribe logger (K.permitItem K.InfoS) K.V2+  le <- K.registerScribe \"otel\" scribe K.defaultScribeSettings =<< K.initLogEnv \"MyApp\" \"production\"+  K.runKatipContextT le () \"main\" $ do+    K.logTM K.InfoS \"Hello from Katip via OTel!\"+@++@since 0.1.0.0+-}+module OpenTelemetry.Instrumentation.Katip (+  makeOTelScribe,+  katipSeverity,+) where++import Control.Monad (void)+import Data.Aeson (Value (..))+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM+import qualified Data.HashMap.Strict as H+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import qualified Katip as K+import qualified Katip.Core as KC+import Language.Haskell.TH.Syntax (Loc (..))+import OpenTelemetry.Attributes.Key (AttributeKey (..), unkey)+import OpenTelemetry.Internal.Common.Types (AnyValue (..), ToValue (..))+import OpenTelemetry.Internal.Log.Types (+  LogRecordArguments (..),+  SeverityNumber (..),+  emptyLogRecordArguments,+ )+import OpenTelemetry.Log.Core (Logger, emitLogRecord)+import qualified OpenTelemetry.SemanticConventions as SC+import OpenTelemetry.SemanticsConfig (StabilityOpt (..), codeOption, getSemanticsOptions)+++{- | Create a Katip 'K.Scribe' that forwards log items to OTel.++@minSev@ is the minimum severity to forward (e.g. @K.InfoS@).+@verb@ controls how much of the 'K.LogItem' payload is serialized+into attributes.++@since 0.1.0.0+-}+makeOTelScribe+  :: Logger+  -> K.Severity+  -> K.Verbosity+  -> IO K.Scribe+makeOTelScribe logger minSev verb =+  pure $+    K.Scribe+      { K.liPush = \item -> do+          permitted <- K.permitItem minSev item+          if permitted+            then emitItem logger verb item+            else pure ()+      , K.scribeFinalizer = pure ()+      , K.scribePermitItem = K.permitItem minSev+      }+++emitItem :: (K.LogItem a) => Logger -> K.Verbosity -> K.Item a -> IO ()+emitItem logger verb item = do+  semOpts <- getSemanticsOptions+  let bodyText = TL.toStrict (TLB.toLazyText (KC.unLogStr (KC._itemMessage item)))+      (sevNum, sevText) = katipSeverity (KC._itemSeverity item)+      attrs = itemAttributes (codeOption semOpts) verb item+      args =+        emptyLogRecordArguments+          { severityText = Just sevText+          , severityNumber = Just sevNum+          , body = toValue bodyText+          , attributes = attrs+          }+  void $ emitLogRecord logger args+++{- | Map Katip 'K.Severity' to OTel 'SeverityNumber' and short text.++@since 0.1.0.0+-}+katipSeverity :: K.Severity -> (SeverityNumber, Text)+katipSeverity K.DebugS = (Debug, "DEBUG")+katipSeverity K.InfoS = (Info, "INFO")+katipSeverity K.NoticeS = (Info2, "NOTICE")+katipSeverity K.WarningS = (Warn, "WARN")+katipSeverity K.ErrorS = (Error, "ERROR")+katipSeverity K.CriticalS = (Fatal, "CRITICAL")+katipSeverity K.AlertS = (Fatal2, "ALERT")+katipSeverity K.EmergencyS = (Fatal4, "EMERGENCY")+++-- | @katip.namespace@ – dot-joined Katip namespace segments (custom attribute).+katipNamespaceKey :: AttributeKey Text+katipNamespaceKey = AttributeKey "katip.namespace"+++itemAttributes :: (K.LogItem a) => StabilityOpt -> K.Verbosity -> K.Item a -> H.HashMap Text AnyValue+itemAttributes semOpts verb item =+  let KC.Namespace ns = KC._itemNamespace item+      base =+        H.fromList $+          concat+            [ [(unkey katipNamespaceKey, toValue (T.intercalate "." ns))]+            , [(unkey SC.thread_id, toValue (KC.getThreadIdText (KC._itemThread item)))]+            , [(unkey SC.server_address, toValue (T.pack (KC._itemHost item)))]+            , [(unkey SC.process_pid, toValue (T.pack (show (KC._itemProcess item))))]+            , maybe [] (locAttrs semOpts) (KC._itemLoc item)+            ]+      payloadAttrs = aesonToAttributes (K.itemJson verb item)+  in H.union base payloadAttrs+  where+    locAttrs opt loc =+      let qualifiedName = T.pack (loc_package loc) <> ":" <> T.pack (loc_module loc)+          stableAttrs =+            [ (unkey SC.code_function_name, toValue qualifiedName)+            , (unkey SC.code_file_path, toValue (T.pack (loc_filename loc)))+            , (unkey SC.code_line_number, IntValue (fromIntegral (fst (loc_start loc))))+            ]+          oldAttrs =+            [ (unkey SC.code_function, toValue (T.pack (loc_module loc)))+            , (unkey SC.code_namespace, toValue qualifiedName)+            , (unkey SC.code_filepath, toValue (T.pack (loc_filename loc)))+            , (unkey SC.code_lineno, IntValue (fromIntegral (fst (loc_start loc))))+            ]+      in case opt of+           Stable -> stableAttrs+           Old -> oldAttrs+           StableAndOld -> stableAttrs <> oldAttrs+++aesonToAttributes :: Value -> H.HashMap Text AnyValue+aesonToAttributes (Object obj) =+  H.fromList (map (\(k, v) -> ("log.payload." <> Key.toText k, aesonToAnyValue v)) (KM.toList obj))+aesonToAttributes _ = H.empty+++aesonToAnyValue :: Value -> AnyValue+aesonToAnyValue (String t) = TextValue t+aesonToAnyValue (Number n) = DoubleValue (realToFrac n)+aesonToAnyValue (Bool b) = BoolValue b+aesonToAnyValue Null = NullValue+aesonToAnyValue (Array arr) = ArrayValue (map aesonToAnyValue (foldr (:) [] arr))+aesonToAnyValue (Object obj) =+  HashMapValue (H.fromList (map (\(k, v) -> (Key.toText k, aesonToAnyValue v)) (KM.toList obj)))
+ test/Spec.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Data.IORef (readIORef)+import qualified Data.Text as T+import Katip+import OpenTelemetry.Exporter.InMemory.LogRecord (getExportedLogRecords, inMemoryLogRecordExporter)+import OpenTelemetry.Instrumentation.Katip (katipSeverity, makeOTelScribe)+import OpenTelemetry.Internal.Log.Types+import OpenTelemetry.Log.Core+import OpenTelemetry.Processor.Simple.LogRecord (SimpleLogRecordProcessorConfig (..), simpleLogRecordProcessor)+import Test.Hspec+++main :: IO ()+main = hspec spec+++spec :: Spec+spec = describe "Katip bridge" $ do+  describe "katipSeverity" $ do+    it "maps DebugS to Debug" $+      fst (katipSeverity DebugS) `shouldBe` Debug+    it "maps InfoS to Info" $+      fst (katipSeverity InfoS) `shouldBe` Info+    it "maps WarningS to Warn" $+      fst (katipSeverity WarningS) `shouldBe` Warn+    it "maps ErrorS to Error" $+      fst (katipSeverity ErrorS) `shouldBe` Error+    it "maps CriticalS to Fatal" $+      fst (katipSeverity CriticalS) `shouldBe` Fatal++  describe "makeOTelScribe" $ do+    it "emits log records to the OTel pipeline" $ do+      (exporter, ref) <- inMemoryLogRecordExporter+      proc <- simpleLogRecordProcessor (SimpleLogRecordProcessorConfig exporter 30000000)+      lp <- createLoggerProvider [proc] emptyLoggerProviderOptions+      let otelLogger = makeLogger lp (instrumentationLibrary "test-katip" "0.0.0")+      scribe <- makeOTelScribe otelLogger InfoS V2+      le <- registerScribe "otel" scribe defaultScribeSettings =<< initLogEnv "TestApp" "test"+      runKatipContextT le () "main" $+        $(logTM) InfoS "hello from katip"+      closeScribes le+      _ <- forceFlushLoggerProvider lp Nothing+      records <- getExportedLogRecords ref+      length records `shouldBe` 1+      let r = head records+      ilr <- readLogRecord r+      toBaseMaybe (logRecordSeverityNumber ilr) `shouldBe` Just Info+      toBaseMaybe (logRecordSeverityText ilr) `shouldBe` Just "INFO"++    it "filters by severity" $ do+      (exporter, ref) <- inMemoryLogRecordExporter+      proc <- simpleLogRecordProcessor (SimpleLogRecordProcessorConfig exporter 30000000)+      lp <- createLoggerProvider [proc] emptyLoggerProviderOptions+      let otelLogger = makeLogger lp (instrumentationLibrary "test-katip" "0.0.0")+      scribe <- makeOTelScribe otelLogger WarningS V2+      le <- registerScribe "otel" scribe defaultScribeSettings =<< initLogEnv "TestApp" "test"+      runKatipContextT le () "main" $ do+        $(logTM) DebugS "debug"+        $(logTM) InfoS "info"+        $(logTM) WarningS "warning"+        $(logTM) ErrorS "error"+      closeScribes le+      _ <- forceFlushLoggerProvider lp Nothing+      records <- reverse <$> getExportedLogRecords ref+      length records `shouldBe` 2+      sevs <- mapM (\r -> logRecordSeverityNumber <$> readLogRecord r) records+      map toBaseMaybe sevs `shouldBe` [Just Warn, Just Error]