Hook version of hedis instrumentation

api/src/OpenTelemetry/Attributes/Key.hs

@@ -5,10 +5,12 @@
 Module      :  OpenTelemetry.Attributes.Key
 Copyright   :  (c) Kazuki Okamoto (岡本和樹), 2023
 License     :  BSD-3
-Description :  Key-value pair metadata used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's
+Description :  Key-value pair keys used in 'OpenTelemetry.Trace.Span's, 'OpenTelemetry.Trace.Link's, and 'OpenTelemetry.Trace.Event's
 Maintainer  :  Kazuki Okamoto (岡本和樹)
 Stability   :  experimental
 Portability :  non-portable (GHC extensions)
+
+This module is based on OpenTelemetry Semantic Conventions 1.24.0.
 -}
 module OpenTelemetry.Attributes.Key (
   Key (..),

cabal.project

@@ -6,6 +6,7 @@ packages:
   , examples/aws-s3
   , examples/grpc-echo
   , examples/hdbc-mysql
+  , examples/hedis
   , examples/http-server
   , examples/yesod-minimal
   , examples/yesod-subsite
@@ -74,6 +75,11 @@ source-repository-package
     location: https://github.com/herp-inc/herp-logger
     tag: v0.3
 
+source-repository-package
+    type: git
+    location: https://github.com/kakkun61/hedis
+    tag: 60313d0c76392f7a00467d40c40fa5e851e0ce11
+
 allow-newer:
     http-api-data:base
   , postgresql-simple:base

docker-compose.yaml

@@ -25,6 +25,11 @@ services:
     ports:
       - "3306:3306"
 
+  redis:
+    image: redis
+    ports:
+      - "6379:6379"
+
   localstack:
     image: localstack/localstack:s3-latest
     ports:

examples/hedis/client.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Exception (bracket)
+import Control.Monad (void)
+import Control.Monad.IO.Class (liftIO)
+import Database.Redis (connect, defaultConnectInfo, get, runRedis, set)
+import OpenTelemetry.Instrumentation.Hedis (appendHooksToConnectionInfo)
+import OpenTelemetry.Trace (defaultSpanArguments, inSpan, initializeTracerProvider, makeTracer, shutdownTracerProvider, tracerOptions)
+import System.IO (hFlush, stdout)
+
+
+main :: IO ()
+main =
+  bracket
+    initializeTracerProvider
+    shutdownTracerProvider
+    $ \tracerProvider -> do
+      let tracer = makeTracer tracerProvider "main" tracerOptions
+      inSpan tracer "main" defaultSpanArguments $ do
+        connInfo <- appendHooksToConnectionInfo tracerProvider defaultConnectInfo
+        connection <- connect connInfo
+        runRedis connection $ do
+          void $ set "hello" "hello"
+          void $ set "world" "world"
+          hello <- get "hello"
+          world <- get "world"
+          liftIO $ print (hello, world)
+      putStr "Press enter to exit after while..."
+      hFlush stdout
+      void $ getLine -- wait for transporting spans

examples/hedis/hedis-example.cabal

@@ -0,0 +1,48 @@
+cabal-version: 3.4
+
+name: hedis-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 hedis-client
+  import: common
+  main-is: client.hs
+  hs-source-dirs: .
+  build-depends: base,
+                 hedis,
+                 hs-opentelemetry-sdk,
+                 hs-opentelemetry-instrumentation-hedis
+
+executable hedis-pubsub
+  import: common
+  main-is: pubsub.hs
+  hs-source-dirs: .
+  build-depends: base,
+                 hedis,
+                 hs-opentelemetry-sdk,
+                 hs-opentelemetry-instrumentation-hedis

examples/hedis/pubsub.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Concurrent (forkIO)
+import Control.Exception (bracket)
+import Control.Monad (void)
+import Control.Monad.IO.Class (liftIO)
+import Database.Redis
+import OpenTelemetry.Instrumentation.Hedis (appendHooksToConnectionInfo)
+import qualified OpenTelemetry.Trace as Otel
+import System.IO (hFlush, stdout)
+
+
+main :: IO ()
+main =
+  bracket
+    Otel.initializeTracerProvider
+    Otel.shutdownTracerProvider
+    $ \tracerProvider -> do
+      let tracer = Otel.makeTracer tracerProvider "hedis-pubsub" Otel.tracerOptions
+      connInfo <- appendHooksToConnectionInfo tracerProvider defaultConnectInfo
+      connection <- connect connInfo
+      void $ forkIO $ Otel.inSpan tracer "single-thread" Otel.defaultSpanArguments $ do
+        runRedis connection $
+          pubSub (subscribe ["hello"]) $ \message -> do
+            Otel.inSpan tracer "single-thread callback" Otel.defaultSpanArguments $ do
+              putStrLn $ "single-thread: received: " ++ show message
+              pure mempty
+      void $ forkIO $ Otel.inSpan tracer "multithread" Otel.defaultSpanArguments $ do
+        controller <- newPubSubController [("hello", helloMessageCallback tracer)] []
+        pubSubForever connection controller $ do
+          putStrLn "subscribed acknowledged"
+      liftIO $ do
+        putStrLn "Press enter to publish a message..."
+        hFlush stdout
+        void $ getLine -- wait for subscribing
+      Otel.inSpan tracer "publish" Otel.defaultSpanArguments $ do
+        runRedis connection $ do
+          void $ publish "hello" "world"
+      putStrLn "Press enter to exit after while..."
+      hFlush stdout
+      void $ getLine -- wait for transporting spans
+
+
+helloMessageCallback :: Otel.Tracer -> MessageCallback
+helloMessageCallback tracer message = do
+  Otel.inSpan tracer "multithread callback" Otel.defaultSpanArguments $ do
+    putStrLn $ "multithread: receive: " ++ show message

hie.yaml

@@ -55,6 +55,9 @@ cradle:
             - path: "examples/hdbc-mysql/main.hs"
               component: "hdbc-mysql-example:exe:hdbc-mysql-example"
 
+            - path: "examples/hedis/client.hs"
+              component: "hedis-example:exe:hedis-client"
+
             - path: "examples/http-server/main.hs"
               component: "http-server:exe:http-server"
 

instrumentation/hedis/hs-opentelemetry-instrumentation-hedis.cabal

@@ -4,7 +4,6 @@ name: hs-opentelemetry-instrumentation-hedis
 version: 0.0.0.0
 author: Kazuki Okamoto (岡本和樹)
 maintainer: kazuki.okamoto@herp.co.jp
-extra-source-files: functions.txt
 
 common common
   build-depends: base >= 4 && < 5
@@ -13,29 +12,19 @@ common common
     ghc-options: -Wcompat
   default-language: Haskell2010
 
-custom-setup
-  setup-depends:
-    base,
-    Cabal,
-    directory,
-    filepath
-
 library
   import: common
-  hs-source-dirs: src, gen
+  hs-source-dirs: src
   exposed-modules: OpenTelemetry.Instrumentation.Hedis
-  other-modules: OpenTelemetry.Instrumentation.Hedis.Internal.Action
-                 OpenTelemetry.Instrumentation.Hedis.Internal.Wrapper
-  autogen-modules: OpenTelemetry.Instrumentation.Hedis.Internal.Action
+  other-modules:
+      Paths_hs_opentelemetry_instrumentation_hedis
+  autogen-modules:
+      Paths_hs_opentelemetry_instrumentation_hedis
   build-depends: hs-opentelemetry-api,
+                 hs-opentelemetry-semantic-conventions,
                  hedis >= 0.14,
                  bytestring,
-                 iproute,
-                 mtl,
-                 safe-exceptions,
-                 text,
-                 unliftio-core,
-                 unordered-containers
+                 text
   ghc-options: -Wcompat
                -Wno-name-shadowing
   if impl(ghc >= 6.4)