{-# 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 -> m [(Text, Attribute)]
staticConnectionAttributes Connection{MVar Connection
connectionHandle :: MVar Connection
connectionHandle :: Connection -> MVar Connection
connectionHandle} = IO [(Text, Attribute)] -> m [(Text, Attribute)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, Attribute)] -> m [(Text, Attribute)])
-> IO [(Text, Attribute)] -> m [(Text, Attribute)]
forall a b. (a -> b) -> a -> b
$ do
  (Maybe ByteString
mDb, Maybe ByteString
mUser, Maybe ByteString
mHost, Maybe ByteString
mPort) <- MVar Connection
-> (Connection
    -> IO
         (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
-> IO
     (Maybe ByteString, Maybe ByteString, Maybe ByteString,
      Maybe ByteString)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m b) -> m b
withMVar MVar Connection
connectionHandle ((Connection
  -> IO
       (Maybe ByteString, Maybe ByteString, Maybe ByteString,
        Maybe ByteString))
 -> IO
      (Maybe ByteString, Maybe ByteString, Maybe ByteString,
       Maybe ByteString))
-> (Connection
    -> IO
         (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
-> IO
     (Maybe ByteString, Maybe ByteString, Maybe ByteString,
      Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Connection
pqConn -> do
    (,,,)
      (Maybe ByteString
 -> Maybe ByteString
 -> Maybe ByteString
 -> Maybe ByteString
 -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
     Maybe ByteString))
-> IO (Maybe ByteString)
-> IO
     (Maybe ByteString
      -> Maybe ByteString
      -> Maybe ByteString
      -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
LibPQ.db Connection
pqConn
      IO
  (Maybe ByteString
   -> Maybe ByteString
   -> Maybe ByteString
   -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
       Maybe ByteString))
-> IO (Maybe ByteString)
-> IO
     (Maybe ByteString
      -> Maybe ByteString
      -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> IO (Maybe ByteString)
LibPQ.user Connection
pqConn 
      IO
  (Maybe ByteString
   -> Maybe ByteString
   -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
       Maybe ByteString))
-> IO (Maybe ByteString)
-> IO
     (Maybe ByteString
      -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> IO (Maybe ByteString)
LibPQ.host Connection
pqConn
      IO
  (Maybe ByteString
   -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
       Maybe ByteString))
-> IO (Maybe ByteString)
-> IO
     (Maybe ByteString, Maybe ByteString, Maybe ByteString,
      Maybe ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> IO (Maybe ByteString)
LibPQ.port Connection
pqConn
  [(Text, Attribute)] -> IO [(Text, Attribute)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Attribute)] -> IO [(Text, Attribute)])
-> [(Text, Attribute)] -> IO [(Text, Attribute)]
forall a b. (a -> b) -> a -> b
$ 
    (Text
"db.system", Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Text
"postgresql" :: T.Text)) (Text, Attribute) -> [(Text, Attribute)] -> [(Text, Attribute)]
forall a. a -> [a] -> [a]
:
    [Maybe (Text, Attribute)] -> [(Text, Attribute)]
forall a. [Maybe a] -> [a]
catMaybes
      [ Text
"db.user" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mUser)
      , Text
"db.name" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mDb)
      , Text
"net.peer.port" Text -> Maybe Int -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (do
          Text
port <- ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mPort
          (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
port) :: Maybe Int
        )
      , case (String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IP)
-> (ByteString -> String) -> ByteString -> Maybe IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack) (ByteString -> Maybe IP) -> Maybe ByteString -> Maybe IP
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ByteString
mHost of
          Maybe IP
Nothing -> Text
"net.peer.name" Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mHost)
          Just (IPv4 IPv4
ipv4) -> Text
"net.peer.ip" Text -> Text -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= String -> Text
T.pack (IPv4 -> String
forall a. Show a => a -> String
show IPv4
ipv4)
          Just (IPv6 IPv6
ipv6) -> Text
"net.peer.ip" Text -> Text -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= String -> Text
T.pack (IPv6 -> String
forall a. Show a => a -> String
show IPv6
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 = _
-}