content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedLists #-}
  {-# LANGUAGE OverloadedStrings #-}
  -- option for module re-export
  {-# OPTIONS_GHC -Wno-missing-import-lists #-}
  
  {- | Wrapper module for @Database.Persist.MySQL@ with @OpenTelemetry.Instrumentation.Persistent@.
  
  [New HTTP semantic conventions have been declared stable.](https://opentelemetry.io/blog/2023/http-conventions-declared-stable/#migration-plan) Opt-in by setting the environment variable OTEL_SEMCONV_STABILITY_OPT_IN to
  - "http" - to use the stable conventions
  - "http/dup" - to emit both the old and the stable conventions
  Otherwise, the old conventions will be used. The stable conventions will replace the old conventions in the next major release of this library.
  -}
  module OpenTelemetry.Instrumentation.Persistent.MySQL (
    withMySQLPool,
    withMySQLConn,
    createMySQLPool,
    module Database.Persist.Sql,
    MySQL.ConnectInfo (..),
    MySQL.SSLInfo (..),
    MySQL.defaultConnectInfo,
    MySQL.defaultSSLInfo,
    Orig.MySQLConf (..),
  
    -- * @ON DUPLICATE KEY UPDATE@ Functionality
    Orig.insertOnDuplicateKeyUpdate,
    Orig.insertManyOnDuplicateKeyUpdate,
    Orig.HandleUpdateCollision,
    Orig.copyField,
    Orig.copyUnlessNull,
    Orig.copyUnlessEmpty,
    Orig.copyUnlessEq,
    openMySQLConn,
  ) where
  
  import Control.Monad.IO.Unlift (MonadUnliftIO)
  import Control.Monad.Logger (MonadLoggerIO)
  import Data.Foldable (Foldable (fold))
  import Data.Functor ((<&>))
  import qualified Data.HashMap.Strict as H
  import Data.IP (IP)
  import Data.Maybe (fromMaybe)
  import Data.Monoid (Last (Last, getLast))
  import Data.Pool (Pool)
  import Data.String (IsString (fromString))
  import Data.Text (Text)
  import Database.MySQL.Base (ConnectInfo (..))
  import qualified Database.MySQL.Base as MySQL
  import qualified Database.Persist.MySQL as Orig
  import Database.Persist.Sql
  import qualified OpenTelemetry.Instrumentation.Persistent as Otel
  import OpenTelemetry.SemanticsConfig
  import qualified OpenTelemetry.Trace.Core as Otel
  import Text.Read (readMaybe)
  
  
  {- | Create a MySQL connection pool.  Note that it's your
  responsibility to properly close the connection pool when
  unneeded.  Use 'withMySQLPool' for automatic resource control.
  -}
  createMySQLPool
    :: (MonadUnliftIO m, MonadLoggerIO m)
    => Otel.TracerProvider
    -> H.HashMap Text Otel.Attribute
    -- ^ Additional attributes.
    -> MySQL.ConnectInfo
    -- ^ Connection information.
    -> Int
    -- ^ Number of connections to be kept open in the pool.
    -> m (Pool SqlBackend)
  createMySQLPool tp attrs ci = createSqlPool $ fmap snd . openMySQLConn tp attrs ci
  
  
  {- | Create a MySQL connection pool and run the given action.
  The pool is properly released after the action finishes using
  it.  Note that you should not use the given 'ConnectionPool'
  outside the action since it may be already been released.
  -}
  withMySQLPool
    :: (MonadLoggerIO m, MonadUnliftIO m)
    => Otel.TracerProvider
    -> H.HashMap Text Otel.Attribute
    -- ^ Additional attributes.
    -> MySQL.ConnectInfo
    -- ^ Connection information.
    -> Int
    -- ^ Number of connections to be kept open in the pool.
    -> (Pool SqlBackend -> m a)
    -- ^ Action to be executed that uses the connection pool.
    -> m a
  withMySQLPool tp attrs ci = withSqlPool $ fmap snd . openMySQLConn tp attrs ci
  
  
  {- | Open a connection to MySQL server, initialize the 'SqlBackend' and return
  their tuple
  
  About attributes, see https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/database/.
  -}
  openMySQLConn
    :: Otel.TracerProvider
    -> H.HashMap Text Otel.Attribute
    -- ^ Additional attributes.
    -> MySQL.ConnectInfo
    -- ^ Connection information.
    -> LogFunc
    -> IO (MySQL.Connection, SqlBackend)
  openMySQLConn tp attrs ci@MySQL.ConnectInfo {connectUser, connectPort, connectOptions, connectHost} logFunc = do
    let
      portAttr, transportAttr :: Otel.Attribute
      portAttr = fromString $ show connectPort
      transportAttr =
        fromMaybe "ip_tcp" $
          getLast $
            fold $
              connectOptions <&> \case
                MySQL.Protocol p ->
                  Last $ Just $ case p of
                    MySQL.TCP -> "ip_tcp"
                    MySQL.Socket -> "other"
                    MySQL.Pipe -> "pipe"
                    MySQL.Memory -> "inproc"
                _ -> Last Nothing
      addStableAttributes =
        H.union
          [ ("db.connection_string" :: Text, fromString $ showsPrecConnectInfoMasked 0 ci "")
          , ("db.user", fromString connectUser)
          , ("server.port", portAttr)
          , ("network.peer.port", portAttr)
          , ("net.transport", transportAttr)
          , (maybe "server.address" (const "network.peer.address") (readMaybe connectHost :: Maybe IP), fromString connectHost)
          ]
      addOldAttributes =
        -- "net.sock.family" is unnecessary because it must be "inet" when "net.sock.peer.addr" or "net.sock.host.addr" is set.
        H.union
          [ ("db.connection_string" :: Text, fromString $ showsPrecConnectInfoMasked 0 ci "")
          , ("db.user", fromString connectUser)
          , ("net.peer.port", portAttr)
          , ("net.sock.peer.port", portAttr)
          , ("net.transport", transportAttr)
          , (maybe "net.peer.name" (const "net.sock.peer.addr") (readMaybe connectHost :: Maybe IP), fromString connectHost)
          ]
  
    semanticsOptions <- getSemanticsOptions
    let attrs' =
          case httpOption semanticsOptions of
            Stable -> addStableAttributes attrs
            StableAndOld -> addStableAttributes $ addOldAttributes attrs
            Old -> addOldAttributes attrs
    (conn, backend) <- Orig.openMySQLConn ci logFunc
    backend' <- Otel.wrapSqlBackend' tp attrs' backend
    pure (conn, backend')
  
  
  {- | Same as 'withMySQLPool', but instead of opening a pool
  of connections, only one connection is opened.
  -}
  withMySQLConn
    :: (MonadUnliftIO m, MonadLoggerIO m)
    => Otel.TracerProvider
    -> H.HashMap Text Otel.Attribute
    -- ^ Additional attributes.
    -> MySQL.ConnectInfo
    -- ^ Connection information.
    -> (SqlBackend -> m a)
    -- ^ Action to be executed that uses the connection.
    -> m a
  withMySQLConn tp attrs ci = withSqlConn $ fmap snd . openMySQLConn tp attrs ci
  
  
  showsPrecConnectInfoMasked :: Int -> MySQL.ConnectInfo -> ShowS
  showsPrecConnectInfoMasked d MySQL.ConnectInfo {connectHost, connectPort, connectUser, connectDatabase, connectOptions, connectPath, connectSSL} =
    showParen (d > 10) $
      showString "ConnectInfo {"
        . showString "connectHost = "
        . shows connectHost
        . showString ", "
        . showString "connectPort = "
        . shows connectPort
        . showString ", "
        . showString "connectUser = "
        . shows connectUser
        . showString ", "
        . showString "connectPassword = \"****\", "
        . showString "connectDatabase = "
        . shows connectDatabase
        . showString ", "
        . showString "connectOptions = "
        . shows connectOptions
        . showString ", "
        . showString "connectPath = "
        . shows connectPath
        . showString ", "
        . showString "connectSSL = "
        . shows connectSSL
        . showString "}"
  