hs-opentelemetry-instrumentation-postgresql-simple 0.0.1.0 → 0.1.0.0

raw patch · 5 files changed

+85/−69 lines, 5 filesdep +unordered-containersdep ~hs-opentelemetry-apisetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: unordered-containers

Dependency ranges changed: hs-opentelemetry-api

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Setup.hs +2/−0
• hs-opentelemetry-instrumentation-postgresql-simple.cabal +16/−14
• src/OpenTelemetry/Instrumentation/PostgresqlSimple.hs +62/−55
• test/Spec.hs +1/−0

@@ -1,3 +1,7 @@ # Changelog for hs-opentelemetry-instrumentation-postgresql-simple  ## Unreleased changes++### Breaking changes++- Use `HashMap Text Attribute` instead of `[(Text, Attribute)]` as attributes

@@ -1,2 +1,4 @@ import Distribution.Simple++ main = defaultMain

@@ -1,20 +1,20 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack -name:           hs-opentelemetry-instrumentation-postgresql-simple-version:        0.0.1.0-description:    Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/postgresql-simple#readme>-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:      2021 Ian Duncan-license:        BSD3-license-file:   LICENSE-build-type:     Simple+name:               hs-opentelemetry-instrumentation-postgresql-simple+version:            0.1.0.0+description:        Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/postgresql-simple#readme>+homepage:           https://github.com/iand675/hs-opentelemetry#readme+bug-reports:        https://github.com/iand675/hs-opentelemetry/issues+author:             Ian Duncan, Jade Lovelace+maintainer:         ian@iankduncan.com+copyright:          2023 Ian Duncan, Mercury Technologies+license:            BSD3+license-file:       LICENSE+build-type:         Simple extra-source-files:     README.md     ChangeLog.md@@ -33,13 +33,14 @@   build-depends:       base >=4.7 && <5     , bytestring-    , hs-opentelemetry-api ==0.0.3.*+    , hs-opentelemetry-api ==0.1.*     , iproute     , network     , postgresql-libpq     , postgresql-simple     , text     , unliftio+    , unordered-containers   default-language: Haskell2010  test-suite hs-opentelemetry-instrumentation-postgresql-simple-test@@ -53,7 +54,7 @@   build-depends:       base >=4.7 && <5     , bytestring-    , hs-opentelemetry-api ==0.0.3.*+    , hs-opentelemetry-api ==0.1.*     , hs-opentelemetry-instrumentation-postgresql-simple     , iproute     , network@@ -61,4 +62,5 @@     , postgresql-simple     , text     , unliftio+    , unordered-containers   default-language: Haskell2010

@@ -1,7 +1,8 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-module OpenTelemetry.Instrumentation.PostgresqlSimple -  ( staticConnectionAttributes++module OpenTelemetry.Instrumentation.PostgresqlSimple (+  staticConnectionAttributes,   {-   -- * Queries that return results     query@@ -32,73 +33,79 @@   -- * Reexported functions   , module X   -}-  ) where+) where  import Control.Monad.IO.Class-import qualified Database.PostgreSQL.Simple as Simple-import Database.PostgreSQL.Simple as X hiding -  ( query-  , query_-  , queryWith-  , queryWith_-  , fold-  , foldWithOptions-  , fold_-  , foldWithOptions_-  , forEach-  , forEach_-  , returning-  , foldWith-  , foldWithOptionsAndParser-  , foldWith_-  , foldWithOptionsAndParser_-  , forEachWith-  , forEachWith_-  , returningWith-  , execute-  , execute_-  , executeMany-  )-import Database.PostgreSQL.Simple.Internal-    ( Connection(Connection, connectionHandle) ) import qualified Data.ByteString.Char8 as C-import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified Data.HashMap.Strict as H+import Data.IP+import Data.Int (Int64)+import Data.Maybe (catMaybes)+import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Database.PostgreSQL.LibPQ as LibPQ+import Database.PostgreSQL.Simple as X hiding (+  execute,+  executeMany,+  execute_,+  fold,+  foldWith,+  foldWithOptions,+  foldWithOptionsAndParser,+  foldWithOptionsAndParser_,+  foldWithOptions_,+  foldWith_,+  fold_,+  forEach,+  forEachWith,+  forEachWith_,+  forEach_,+  query,+  queryWith,+  queryWith_,+  query_,+  returning,+  returningWith,+ )+import qualified Database.PostgreSQL.Simple as Simple+import qualified Database.PostgreSQL.Simple.FromRow as Simple+import Database.PostgreSQL.Simple.Internal (+  Connection (Connection, connectionHandle),+ )+import GHC.Stack+import OpenTelemetry.Resource ((.=), (.=?)) import OpenTelemetry.Trace.Core import OpenTelemetry.Trace.Monad-import OpenTelemetry.Resource ((.=), (.=?))-import Data.Maybe (catMaybes)-import qualified Data.Text.Encoding as TE import Text.Read (readMaybe)-import Data.IP-import qualified Database.PostgreSQL.Simple.FromRow as Simple-import Data.Int (Int64) import UnliftIO-import Data.Text (Text)-import GHC.Stack -staticConnectionAttributes :: MonadIO m => Connection -> m [(T.Text, Attribute)]-staticConnectionAttributes Connection{connectionHandle} = liftIO $ do++-- | Get attributes that can be attached to a span denoting some database action+staticConnectionAttributes :: (MonadIO m) => Connection -> m (H.HashMap T.Text Attribute)+staticConnectionAttributes Connection {connectionHandle} = liftIO $ do   (mDb, mUser, mHost, mPort) <- withMVar connectionHandle $ \pqConn -> do     (,,,)       <$> LibPQ.db pqConn-      <*> LibPQ.user pqConn +      <*> LibPQ.user pqConn       <*> LibPQ.host pqConn       <*> LibPQ.port pqConn-  pure $ -    ("db.system", toAttribute ("postgresql" :: T.Text)) :-    catMaybes-      [ "db.user" .=? (TE.decodeUtf8 <$> mUser)-      , "db.name" .=? (TE.decodeUtf8 <$> mDb)-      , "net.peer.port" .=? (do-          port <- TE.decodeUtf8 <$> mPort-          (readMaybe $ T.unpack port) :: Maybe Int-        )-      , case (readMaybe . C.unpack) =<< mHost of-          Nothing -> "net.peer.name" .=? (TE.decodeUtf8 <$> mHost)-          Just (IPv4 ipv4) -> "net.peer.ip" .= T.pack (show ipv4)-          Just (IPv6 ipv6) -> "net.peer.ip" .= T.pack (show ipv6)-      ]+  pure $+    H.fromList $+      catMaybes+        [ "db.system" .= toAttribute ("postgresql" :: T.Text)+        , "db.user" .=? (TE.decodeUtf8 <$> mUser)+        , "db.name" .=? (TE.decodeUtf8 <$> mDb)+        , "net.peer.port"+            .=? ( do+                    port <- TE.decodeUtf8 <$> mPort+                    (readMaybe $ T.unpack port) :: Maybe Int+                )+        , case (readMaybe . C.unpack) =<< mHost of+            Nothing -> "net.peer.name" .=? (TE.decodeUtf8 <$> mHost)+            Just (IPv4 ipv4) -> "net.peer.ip" .= T.pack (show ipv4)+            Just (IPv6 ipv6) -> "net.peer.ip" .= T.pack (show ipv6)+        ]  {- -- | Perform a @SELECT@ or other SQL query that is expected to return

@@ -1,2 +1,3 @@+ main :: IO () main = putStrLn "Test suite not yet implemented"