packages feed

hs-opentelemetry-instrumentation-postgresql-simple (empty) → 0.0.1.0

raw patch · 7 files changed

+455/−0 lines, 7 filesdep +basedep +bytestringdep +hs-opentelemetry-apisetup-changed

Dependencies added: base, bytestring, hs-opentelemetry-api, hs-opentelemetry-instrumentation-postgresql-simple, iproute, network, postgresql-libpq, postgresql-simple, text, unliftio

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for hs-opentelemetry-instrumentation-postgresql-simple++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ian Duncan (c) 2021++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.
+ README.md view
@@ -0,0 +1,1 @@+# hs-opentelemetry-instrumentation-postgresql-simple
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hs-opentelemetry-instrumentation-postgresql-simple.cabal view
@@ -0,0 +1,64 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- 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+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/iand675/hs-opentelemetry++library+  exposed-modules:+      OpenTelemetry.Instrumentation.PostgresqlSimple+  other-modules:+      Paths_hs_opentelemetry_instrumentation_postgresql_simple+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , bytestring+    , hs-opentelemetry-api ==0.0.3.*+    , iproute+    , network+    , postgresql-libpq+    , postgresql-simple+    , text+    , unliftio+  default-language: Haskell2010++test-suite hs-opentelemetry-instrumentation-postgresql-simple-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_hs_opentelemetry_instrumentation_postgresql_simple+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring+    , hs-opentelemetry-api ==0.0.3.*+    , hs-opentelemetry-instrumentation-postgresql-simple+    , iproute+    , network+    , postgresql-libpq+    , postgresql-simple+    , text+    , unliftio+  default-language: Haskell2010
+ src/OpenTelemetry/Instrumentation/PostgresqlSimple.hs view
@@ -0,0 +1,353 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+module OpenTelemetry.Instrumentation.PostgresqlSimple +  ( staticConnectionAttributes+  {-+  -- * Queries that return results+    query+  , query_+  -- ** Queries taking parser as argument+  , queryWith+  , queryWith_+  -- * Queries that stream results+  , fold+  , foldWithOptions+  , fold_+  , foldWithOptions_+  , forEach+  , forEach_+  , returning+  -- ** Queries that stream results taking a parser as an argument+  , foldWith+  , foldWithOptionsAndParser+  , foldWith_+  , foldWithOptionsAndParser_+  , forEachWith+  , forEachWith_+  , returningWith+  -- * Statements that do not return results+  , execute+  , execute_+  , executeMany+  -- * Reexported functions+  , module X+  -}+  ) 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.Text as T+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+  (mDb, mUser, mHost, mPort) <- withMVar connectionHandle $ \pqConn -> do+    (,,,)+      <$> LibPQ.db 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)+      ]++{-+-- | Perform a @SELECT@ or other SQL query that is expected to return+-- results. All results are retrieved and converted before this+-- function returns.+--+-- When processing large results, this function will consume a lot of+-- client-side memory.  Consider using 'fold' instead.+--+-- Exceptions that may be thrown:+--+-- * 'FormatError': the query string could not be formatted correctly.+--+-- * 'QueryError': the result contains no columns (i.e. you should be+--   using 'execute' instead of 'query').+--+-- * 'ResultError': result conversion failed.+--+-- * 'SqlError':  the postgresql backend returned an error,  e.g.+--   a syntax or type error,  or an incorrect table or column name.+query :: (MonadIO m, MonadGetContext m, ToRow q, FromRow r) => Connection -> Query -> q -> m [r]+query = liftIO $ Simple.query++-- | A version of 'query' that does not perform query substitution.+query_ :: (MonadIO m, MonadGetContext m, FromRow r) => Connection -> Query -> m [r]+query_ = _++-- | A version of 'query' taking parser as argument+queryWith :: (MonadIO m, MonadGetContext m, ToRow q) => Simple.RowParser r -> Connection -> Query -> q -> m [r]+queryWith parser conn template qs = _++-- | A version of 'query_' taking parser as argument+queryWith_ :: (MonadIO m, MonadGetContext m) => Simple.RowParser r -> Connection -> Query -> m [r]+queryWith_ parser conn q = _++-- | Perform a @SELECT@ or other SQL query that is expected to return+-- results. Results are streamed incrementally from the server, and+-- consumed via a left fold.+--+-- When dealing with small results, it may be simpler (and perhaps+-- faster) to use 'query' instead.+--+-- This fold is /not/ strict. The stream consumer is responsible for+-- forcing the evaluation of its result to avoid space leaks.+--+-- This is implemented using a database cursor.    As such,  this requires+-- a transaction.   This function will detect whether or not there is a+-- transaction in progress,  and will create a 'ReadCommitted' 'ReadOnly'+-- transaction if needed.   The cursor is given a unique temporary name,+-- so the consumer may itself call fold.+--+-- Exceptions that may be thrown:+--+-- * 'FormatError': the query string could not be formatted correctly.+--+-- * 'QueryError': the result contains no columns (i.e. you should be+--   using 'execute' instead of 'query').+--+-- * 'ResultError': result conversion failed.+--+-- * 'SqlError':  the postgresql backend returned an error,  e.g.+--   a syntax or type error,  or an incorrect table or column name.+fold            :: (MonadBracketError m, MonadLocalContext m, FromRow row, ToRow params)+                => Connection+                -> Query+                -> params+                -> a+                -> (a -> row -> m a)+                -> m a+fold = _++-- | A version of 'fold' taking a parser as an argument+foldWith        :: (MonadBracketError m, MonadLocalContext m, ToRow params)+                => Simple.RowParser row+                -> Connection+                -> Query+                -> params+                -> a+                -> (a -> row -> m a)+                -> m a+foldWith = _+-- | The same as 'fold',  but this provides a bit more control over+--   lower-level details.  Currently,  the number of rows fetched per+--   round-trip to the server and the transaction mode may be adjusted+--   accordingly.    If the connection is already in a transaction,+--   then the existing transaction is used and thus the 'transactionMode'+--   option is ignored.+foldWithOptions :: (MonadBracketError m, MonadLocalContext m, FromRow row, ToRow params)+                => FoldOptions+                -> Connection+                -> Query+                -> params+                -> a+                -> (a -> row -> m a)+                -> m a+foldWithOptions opts = _++-- | A version of 'foldWithOptions' taking a parser as an argument+foldWithOptionsAndParser :: (MonadBracketError m, MonadLocalContext m, ToRow params)+                         => FoldOptions+                         -> Simple.RowParser row+                         -> Connection+                         -> Query+                         -> params+                         -> a+                         -> (a -> row -> m a)+                         -> m a+foldWithOptionsAndParser opts parser conn template qs a f = _++-- | A version of 'fold' that does not perform query substitution.+fold_ :: (MonadBracketError m, MonadLocalContext m, FromRow r) =>+         Connection+      -> Query                  -- ^ Query.+      -> a                      -- ^ Initial state for result consumer.+      -> (a -> r -> m a)       -- ^ Result consumer.+      -> m a+fold_ = _++-- | A version of 'fold_' taking a parser as an argument+foldWith_ :: (MonadUnliftIO m, MonadBracketError m, MonadLocalContext m) =>+             Simple.RowParser r+          -> Connection+          -> Query+          -> a+          -> (a -> r -> m a)+          -> m a+foldWith_ = _++foldWithOptions_ :: (MonadUnliftIO m, MonadBracketError m, MonadLocalContext m, FromRow r) =>+                    FoldOptions+                 -> Connection+                 -> Query             -- ^ Query.+                 -> a                 -- ^ Initial state for result consumer.+                 -> (a -> r -> m a)  -- ^ Result consumer.+                 -> m a+foldWithOptions_ opts conn query' a f = Simple.foldWithOptions_ opts conn query' a f++-- | A version of 'foldWithOptions_' taking a parser as an argument+foldWithOptionsAndParser_ :: FoldOptions+                          -> Simple.RowParser r+                          -> Connection+                          -> Query             -- ^ Query.+                          -> a                 -- ^ Initial state for result consumer.+                          -> (a -> r -> IO a)  -- ^ Result consumer.+                          -> IO a+foldWithOptionsAndParser_ opts parser conn query' a f = _++-- | A version of 'fold' that does not transform a state value.+forEach :: (MonadUnliftIO m, MonadBracketError m, MonadLocalContext m, ToRow q, FromRow r) =>+           Connection+        -> Query                -- ^ Query template.+        -> q                    -- ^ Query parameters.+        -> (r -> m ())         -- ^ Result consumer.+        -> m ()+forEach = _+{-# INLINE forEach #-}++-- | A version of 'forEach' taking a parser as an argument+forEachWith :: (MonadBracketError m, MonadLocalContext m, ToRow q)+            => Simple.RowParser r+            -> Connection+            -> Query+            -> q+            -> (r -> m ())+            -> m ()+forEachWith parser conn template qs = _+{-# INLINE forEachWith #-}++-- | A version of 'forEach' that does not perform query substitution.+forEach_ :: (MonadBracketError m, MonadLocalContext m, FromRow r) =>+            Connection+         -> Query                -- ^ Query template.+         -> (r -> m ())         -- ^ Result consumer.+         -> m ()+forEach_ = _+{-# INLINE forEach_ #-}++forEachWith_ :: (MonadBracketError m, MonadLocalContext m) =>+                Simple.RowParser r+             -> Connection+             -> Query+             -> (r -> m ())+             -> m ()+forEachWith_ parser conn template = _+{-# INLINE forEachWith_ #-}++-- | Execute @INSERT ... RETURNING@, @UPDATE ... RETURNING@, or other SQL+-- query that accepts multi-row input and is expected to return results.+-- Note that it is possible to write+--    @'query' conn "INSERT ... RETURNING ..." ...@+-- in cases where you are only inserting a single row,  and do not need+-- functionality analogous to 'executeMany'.+--+-- If the list of parameters is empty,  this function will simply return @[]@+-- without issuing the query to the backend.   If this is not desired,+-- consider using the 'Values' constructor instead.+--+-- Throws 'FormatError' if the query could not be formatted correctly.+returning :: (MonadIO m, MonadGetContext m, ToRow q, FromRow r) => Connection -> Query -> [q] -> m [r]+returning = _++-- | A version of 'returning' taking parser as argument+returningWith :: (MonadIO m, MonadGetContext m, ToRow q) => Simple.RowParser r -> Connection -> Query -> [q] -> m [r]+returningWith = _++-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not+-- expected to return results.+--+-- Returns the number of rows affected.+--+-- Throws 'FormatError' if the query could not be formatted correctly, or+-- a 'SqlError' exception if the backend returns an error.+execute :: (MonadIO m, MonadGetContext m, ToRow q) => Connection -> Query -> q -> m Int64+execute conn template qs = _++-- | A version of 'execute' that does not perform query substitution.+execute_ :: (MonadIO m, MonadGetContext m) => Connection -> Query -> m Int64+execute_ = _++-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not+-- expected to return results.+--+-- Returns the number of rows affected.   If the list of parameters is empty,+-- this function will simply return 0 without issuing the query to the backend.+-- If this is not desired, consider using the 'Values' constructor instead.+--+-- Throws 'FormatError' if the query could not be formatted correctly, or+-- a 'SqlError' exception if the backend returns an error.+--+-- For example,  here's a command that inserts two rows into a table+-- with two columns:+--+-- @+-- executeMany c [sql|+--     INSERT INTO sometable VALUES (?,?)+--  |] [(1, \"hello\"),(2, \"world\")]+-- @+--+-- Here's an canonical example of a multi-row update command:+--+-- @+-- executeMany c [sql|+--     UPDATE sometable+--        SET y = upd.y+--       FROM (VALUES (?,?)) as upd(x,y)+--      WHERE sometable.x = upd.x+--  |] [(1, \"hello\"),(2, \"world\")]+-- @++executeMany :: (MonadIO m, MonadGetContext m, ToRow q) => Connection -> Query -> [q] -> m Int64+executeMany = _+-}
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"