{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.Raw.Connection
  ( ConnectionOptions
      ( ConnectionOptions
      , connectionString
      , connectionNoticeReporting
      , connectionPoolStripes
      , connectionPoolLingerTime
      , connectionPoolMaxConnections
      )
  , NoticeReporting (EnableNoticeReporting, DisableNoticeReporting)
  , MaxConnections (MaxConnectionsTotal, MaxConnectionsPerStripe)
  , StripeOption (OneStripePerCapability, StripeCount)
  , ConnectionPool
  , createConnectionPool
  , Connection
  , withPoolConnection
  , executeRaw
  , quoteStringLiteral
  , quoteIdentifier
  , ConnectionUsedAfterCloseError
  , ConnectionError
  , SqlExecutionError (..)
  )
where

import Control.Concurrent (getNumCapabilities, threadWaitRead, threadWaitWrite)
import Control.Concurrent.MVar (MVar, newMVar, tryReadMVar, tryTakeMVar)
import Control.Exception (Exception, mask, throwIO)
import Control.Monad (void)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromMaybe)
#if MIN_VERSION_resource_pool(0,4,0)
import Data.Pool (Pool, newPool, defaultPoolConfig, setNumStripes, withResource)
#else
import Data.Pool (Pool, createPool, withResource)
#endif
import qualified Data.Text as T
import qualified Data.Text.Encoding as Enc
import Data.Time (NominalDiffTime)
import qualified Database.PostgreSQL.LibPQ as LibPQ

import Orville.PostgreSQL.Raw.PgTextFormatValue (NULByteFoundError (NULByteFoundError), PgTextFormatValue, toBytesForLibPQ)

{- |
  An option for 'createConnectionPool' that indicates whether LibPQ should
  print notice reports for warnings to the console.

@since 1.0.0.0
-}
data NoticeReporting
  = EnableNoticeReporting
  | DisableNoticeReporting

{- |
Orville always uses a connection pool to manage the number of open connections
to the database. See 'ConnectionConfig' and 'createConnectionPool' to find how
to create a 'ConnectionPool'.

@since 1.0.0.0
-}
newtype ConnectionPool
  = ConnectionPool (Pool Connection)

{- |
 'createConnectionPool' allocates a pool of connections to a PostgreSQL server.

@since 1.0.0.0
-}
createConnectionPool :: ConnectionOptions -> IO ConnectionPool
createConnectionPool :: ConnectionOptions -> IO ConnectionPool
createConnectionPool ConnectionOptions
options = do
  let
    open :: IO Connection
open =
      NoticeReporting -> ByteString -> IO Connection
connect
        (ConnectionOptions -> NoticeReporting
connectionNoticeReporting ConnectionOptions
options)
        (String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ConnectionOptions -> String
connectionString ConnectionOptions
options)

    linger :: NominalDiffTime
linger =
      ConnectionOptions -> NominalDiffTime
connectionPoolLingerTime ConnectionOptions
options

    maxConns :: MaxConnections
maxConns =
      ConnectionOptions -> MaxConnections
connectionPoolMaxConnections ConnectionOptions
options

  Int
stripes <- StripeOption -> IO Int
determineStripeCount (ConnectionOptions -> StripeOption
connectionPoolStripes ConnectionOptions
options)

  Int
connPerStripe <-
    case Int -> MaxConnections -> Either String Int
determineConnectionsPerStripe Int
stripes MaxConnections
maxConns of
      Right Int
conns -> Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
conns
      Left String
err ->
        ConnectionError -> IO Int
forall e a. Exception e => e -> IO a
throwIO (ConnectionError -> IO Int) -> ConnectionError -> IO Int
forall a b. (a -> b) -> a -> b
$
          ConnectionError
            { connectionErrorMessage :: String
connectionErrorMessage = String
err
            , connectionErrorLibPQMessage :: Maybe ByteString
connectionErrorLibPQMessage = Maybe ByteString
forall a. Maybe a
Nothing
            }

#if MIN_VERSION_resource_pool(0,4,0)
  (Pool Connection -> ConnectionPool)
-> IO (Pool Connection) -> IO ConnectionPool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pool Connection -> ConnectionPool
ConnectionPool (IO (Pool Connection) -> IO ConnectionPool)
-> (PoolConfig Connection -> IO (Pool Connection))
-> PoolConfig Connection
-> IO ConnectionPool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolConfig Connection -> IO (Pool Connection)
forall a. PoolConfig a -> IO (Pool a)
newPool (PoolConfig Connection -> IO (Pool Connection))
-> (PoolConfig Connection -> PoolConfig Connection)
-> PoolConfig Connection
-> IO (Pool Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> PoolConfig Connection -> PoolConfig Connection
forall a. Maybe Int -> PoolConfig a -> PoolConfig a
setNumStripes (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
stripes) (PoolConfig Connection -> IO ConnectionPool)
-> PoolConfig Connection -> IO ConnectionPool
forall a b. (a -> b) -> a -> b
$
    IO Connection
-> (Connection -> IO ()) -> Double -> Int -> PoolConfig Connection
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
defaultPoolConfig
      IO Connection
open
      Connection -> IO ()
close
      (NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
linger)
      (Int
stripes Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
connPerStripe)
#else
  ConnectionPool <$>
    createPool
      open
      close
      stripes
      linger
      connPerStripe
#endif

{- |
Values for the 'connectionPoolStripes' field of 'ConnectionOptions'.

@since 1.0.0.0
-}
data StripeOption
  = -- | 'OneStripePerCapability' will cause the connection pool to be set up
    -- with one stripe for each capability (processor thread) available to the
    -- runtime. This is the best option for multi-threaded connection pool
    -- performance.
    OneStripePerCapability
  | -- | 'StripeCount' will cause the connection pool to be set up with
    -- the specified number of stripes, regardless of how many capabilities
    -- the runtime has.
    StripeCount Int

{- |
Values for the 'connectionMaxConnections' field of 'ConnectionOptions'.

@since 1.0.0.0
-}
data MaxConnections
  = -- | 'MaxConnectionsTotal' creates a connection pool that will never
    -- allocate more than the specified number of connections. The total count
    -- of connections will be spread evenly across the all the stripes in the
    -- pool. If the number of stripes does not divide the total count evenly,
    -- any remainder will be unused.
    MaxConnectionsTotal Int
  | -- | 'MaxConnectionsPerStripe' creates a connection pool that will
    -- allocate up to the specified number of connections in each stripe.
    -- In this case the total possible number of simultaneous connections will
    -- be this value multiplied by the number of stripes.
    MaxConnectionsPerStripe Int

{- |
Configuration options to pass to 'createConnectionPool' to specify the
parameters for the pool and the connections that it creates.

@since 1.0.0.0
-}
data ConnectionOptions = ConnectionOptions
  { ConnectionOptions -> String
connectionString :: String
  -- ^ A PostgreSQL connection string.
  , ConnectionOptions -> NoticeReporting
connectionNoticeReporting :: NoticeReporting
  -- ^ Whether or not notice reporting from LibPQ should be enabled.
  , ConnectionOptions -> StripeOption
connectionPoolStripes :: StripeOption
  -- ^ Number of stripes in the connection pool.
  , ConnectionOptions -> NominalDiffTime
connectionPoolLingerTime :: NominalDiffTime
  -- ^ Linger time before closing an idle connection.
  , ConnectionOptions -> MaxConnections
connectionPoolMaxConnections :: MaxConnections
  -- ^ Controls the number of connections available in the 'ConnectionPool'.
  }

{- |
  INTERNAL: Resolves the 'StripeOption' to the actual number of stripes to use.
-}
determineStripeCount :: StripeOption -> IO Int
determineStripeCount :: StripeOption -> IO Int
determineStripeCount StripeOption
stripeOption =
  case StripeOption
stripeOption of
    StripeOption
OneStripePerCapability -> IO Int
getNumCapabilities
    StripeCount Int
n -> Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n

{- |
  INTERNAL: Resolves the 'MaxConnections' to the actual number of connections
  to use per stripe.
-}
determineConnectionsPerStripe :: Int -> MaxConnections -> Either String Int
determineConnectionsPerStripe :: Int -> MaxConnections -> Either String Int
determineConnectionsPerStripe Int
stripes MaxConnections
maxConnections =
  case MaxConnections
maxConnections of
    MaxConnectionsPerStripe Int
n ->
      Int -> Either String Int
forall a b. b -> Either a b
Right Int
n
    MaxConnectionsTotal Int
n ->
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
stripes
        then Int -> Either String Int
forall a b. b -> Either a b
Right (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
stripes)
        else
          String -> Either String Int
forall a b. a -> Either a b
Left (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$
            String
"Invalid connection pool options. There must be at least "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" 1 connection per stripe, but MaxConnectionsTotal was "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" for "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
stripes
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" stripes."

{- |
  Allocates a connection from the pool and performs an action with it. This
  function will block if the maximum number of connections is reached.

@since 1.0.0.0
-}
withPoolConnection :: ConnectionPool -> (Connection -> IO a) -> IO a
withPoolConnection :: forall a. ConnectionPool -> (Connection -> IO a) -> IO a
withPoolConnection (ConnectionPool Pool Connection
pool) =
  Pool Connection -> (Connection -> IO a) -> IO a
forall a r. Pool a -> (a -> IO r) -> IO r
withResource Pool Connection
pool

{- |
  'executeRaw' runs a given SQL statement returning the raw underlying result.

 All handling of stepping through the result set is left to the caller. This
 potentially leaves connections open much longer than one would expect if all
 of the results are not iterated through immediately *and* the data copied.
 Use with caution.

@since 1.0.0.0
-}
executeRaw ::
  Connection ->
  BS.ByteString ->
  [Maybe PgTextFormatValue] ->
  IO LibPQ.Result
executeRaw :: Connection -> ByteString -> [Maybe PgTextFormatValue] -> IO Result
executeRaw Connection
connection ByteString
bs [Maybe PgTextFormatValue]
params =
  case (Maybe PgTextFormatValue
 -> Either NULByteFoundError (Maybe ByteString))
-> [Maybe PgTextFormatValue]
-> Either NULByteFoundError [Maybe ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((PgTextFormatValue -> Either NULByteFoundError ByteString)
-> Maybe PgTextFormatValue
-> Either NULByteFoundError (Maybe ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse PgTextFormatValue -> Either NULByteFoundError ByteString
toBytesForLibPQ) [Maybe PgTextFormatValue]
params of
    Left NULByteFoundError
NULByteFoundError ->
      NULByteFoundError -> IO Result
forall e a. Exception e => e -> IO a
throwIO NULByteFoundError
NULByteFoundError
    Right [Maybe ByteString]
paramBytes ->
      ByteString -> [Maybe ByteString] -> Connection -> IO Result
underlyingExecute ByteString
bs [Maybe ByteString]
paramBytes Connection
connection

{- |
  An Orville handler for a LibPQ connection.

@since 1.0.0.0
-}
newtype Connection = Connection (MVar LibPQ.Connection)

{- |
  'connect' is the internal, primitive connection function.

 This should not be exposed to end users, but instead wrapped in something to create a pool.

 Note that handling the LibPQ connection with the polling is described at
 <https://hackage.haskell.org/package/postgresql-libpq-0.9.4.2/docs/Database-PostgreSQL-LibPQ.html>.

@since 1.0.0.0
-}
connect :: NoticeReporting -> BS.ByteString -> IO Connection
connect :: NoticeReporting -> ByteString -> IO Connection
connect NoticeReporting
noticeReporting ByteString
connString =
  let
    checkSocketAndThreadWait :: Connection -> (Fd -> IO ()) -> IO Connection
checkSocketAndThreadWait Connection
conn Fd -> IO ()
threadWaitFn = do
      Maybe Fd
fd <- Connection -> IO (Maybe Fd)
LibPQ.socket Connection
conn
      case Maybe Fd
fd of
        Maybe Fd
Nothing -> do
          String -> Connection -> IO Connection
forall a. String -> Connection -> IO a
throwConnectionError String
"connect: failed to get file descriptor for socket" Connection
conn
        Just Fd
fd' -> do
          Fd -> IO ()
threadWaitFn Fd
fd'
          Connection -> IO Connection
poll Connection
conn

    poll :: Connection -> IO Connection
poll Connection
conn = do
      PollingStatus
pollStatus <- Connection -> IO PollingStatus
LibPQ.connectPoll Connection
conn
      case PollingStatus
pollStatus of
        PollingStatus
LibPQ.PollingFailed -> do
          String -> Connection -> IO Connection
forall a. String -> Connection -> IO a
throwConnectionError String
"connect: polling failed while connecting to database server" Connection
conn
        PollingStatus
LibPQ.PollingReading ->
          Connection -> (Fd -> IO ()) -> IO Connection
checkSocketAndThreadWait Connection
conn Fd -> IO ()
threadWaitRead
        PollingStatus
LibPQ.PollingWriting ->
          Connection -> (Fd -> IO ()) -> IO Connection
checkSocketAndThreadWait Connection
conn Fd -> IO ()
threadWaitWrite
        PollingStatus
LibPQ.PollingOk -> do
          MVar Connection
connectionHandle <- Connection -> IO (MVar Connection)
forall a. a -> IO (MVar a)
newMVar Connection
conn
          Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVar Connection -> Connection
Connection MVar Connection
connectionHandle)
  in
    do
      Connection
connection <- ByteString -> IO Connection
LibPQ.connectStart ByteString
connString
      case NoticeReporting
noticeReporting of
        NoticeReporting
DisableNoticeReporting -> Connection -> IO ()
LibPQ.disableNoticeReporting Connection
connection
        NoticeReporting
EnableNoticeReporting -> Connection -> IO ()
LibPQ.enableNoticeReporting Connection
connection
      Connection -> IO Connection
poll Connection
connection

{- |
  'close' has many subtleties to it.

  First note that async exceptions are masked.  'mask' though, only works for
  things that are not interruptible
  <https://www.stackage.org/haddock/lts-16.15/base-4.13.0.0/Control-Exception.html#g:13>

  From the previous link, 'tryTakeMVar' is not interruptible, where @takeMVar@
  *is*.  So by using 'tryTakeMVar' along with 'mask', we should be safe from
  async exceptions causing us to not finish an underlying connection.  Notice
  that the only place the MVar is ever taken is here so 'tryTakeMVar' gives us
  both the non-blocking semantics to protect from async exceptions with 'mask'
  _and_ should never truly return an empty unless two threads were racing to
  close the connection, in which case.. one of them will close the connection.

@since 1.0.0.0
-}
close :: Connection -> IO ()
close :: Connection -> IO ()
close (Connection MVar Connection
handle) =
  let
    underlyingFinish :: (forall a. IO a -> IO a) -> IO (Maybe ())
    underlyingFinish :: (forall a. IO a -> IO a) -> IO (Maybe ())
underlyingFinish forall a. IO a -> IO a
restore = do
      Maybe Connection
underlyingConnection <- MVar Connection -> IO (Maybe Connection)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Connection
handle
      IO (Maybe ()) -> IO (Maybe ())
forall a. IO a -> IO a
restore ((Connection -> IO ()) -> Maybe Connection -> IO (Maybe ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Connection -> IO ()
LibPQ.finish Maybe Connection
underlyingConnection)
  in
    IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ((forall a. IO a -> IO a) -> IO (Maybe ())) -> IO (Maybe ())
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (forall a. IO a -> IO a) -> IO (Maybe ())
underlyingFinish

{- |
 'underlyingExecute' is the internal, primitive execute function.

  This is not intended to be directly exposed to end users, but instead wrapped
  in something using a pool.  Note there are potential dragons here in that
  this calls @tryReadMvar@ and then returns an error if the MVar is not full.
  The intent is to never expose the ability to empty the `MVar` outside of this
  module, so unless a connection has been closed it *should* never be empty.
  And a connection should be closed upon removal from a resource pool (in which
  case it can't be used for this  function in the first place).

@since 1.0.0.0
-}
underlyingExecute ::
  BS.ByteString ->
  [Maybe BS.ByteString] ->
  Connection ->
  IO LibPQ.Result
underlyingExecute :: ByteString -> [Maybe ByteString] -> Connection -> IO Result
underlyingExecute ByteString
bs [Maybe ByteString]
params Connection
connection = do
  Connection
libPQConn <- Connection -> IO Connection
readLibPQConnectionOrFailIfClosed Connection
connection
  Maybe Result
mbResult <-
    Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO (Maybe Result)
LibPQ.execParams Connection
libPQConn ByteString
bs ((Maybe ByteString -> Maybe (Oid, ByteString, Format))
-> [Maybe ByteString] -> [Maybe (Oid, ByteString, Format)]
forall a b. (a -> b) -> [a] -> [b]
map Maybe ByteString -> Maybe (Oid, ByteString, Format)
mkInferredTextParam [Maybe ByteString]
params) Format
LibPQ.Text

  case Maybe Result
mbResult of
    Maybe Result
Nothing -> do
      Connection -> ByteString -> IO Result
forall a. Connection -> ByteString -> IO a
throwExecutionErrorWithoutResult Connection
libPQConn ByteString
bs
    Just Result
result -> do
      ExecStatus
execStatus <- Result -> IO ExecStatus
LibPQ.resultStatus Result
result

      if ExecStatus -> Bool
isRowReadableStatus ExecStatus
execStatus
        then Result -> IO Result
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
result
        else Result -> ExecStatus -> ByteString -> IO Result
forall a. Result -> ExecStatus -> ByteString -> IO a
throwExecutionErrorWithResult Result
result ExecStatus
execStatus ByteString
bs

{- |
  Escapes and quotes a string for use as a literal within a SQL command that
  will be executed on the given connection. This uses the @PQescapeStringConn@
  function from LibPQ, which takes the character encoding of the connection
  into account. Note that while @PQescapeStringConn@ does not surround the
  literal with quotes, this function does for the sake of symmetry with
  'quoteIdentifier'.

  This function returns a `BSB.Builder` so that the result can be included in
  a builder being constructed for the surrounding SQL command without making
  an additional copy of the `BS.ByteString` returned by LibPQ for the sake of
  adding the surrounding quotes.

@since 1.0.0.0
-}
quoteStringLiteral :: Connection -> BS.ByteString -> IO BSB.Builder
quoteStringLiteral :: Connection -> ByteString -> IO Builder
quoteStringLiteral Connection
connection ByteString
unquotedString = do
  Connection
libPQConn <- Connection -> IO Connection
readLibPQConnectionOrFailIfClosed Connection
connection
  Maybe ByteString
mbEscapedString <- Connection -> ByteString -> IO (Maybe ByteString)
LibPQ.escapeStringConn Connection
libPQConn ByteString
unquotedString

  case Maybe ByteString
mbEscapedString of
    Maybe ByteString
Nothing ->
      String -> Connection -> IO Builder
forall a. String -> Connection -> IO a
throwConnectionError String
"Error while escaping string literal" Connection
libPQConn
    Just ByteString
escapedString ->
      let
        singleQuote :: Builder
singleQuote =
          Char -> Builder
BSB.char8 Char
'\''
      in
        Builder -> IO Builder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder
singleQuote Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
escapedString Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
singleQuote)

{- |
  Escapes and quotes a string for use as an identifier within a SQL command
  that will be executed on the given connection. This uses the
  @PQescapeIdentifier@ function from LibPQ, which takes the character encoding
  of the connection into account and also applies the quotes.

  Although this function does not need to copy the `BS.ByteString` returned by
  LibPQ to add the quotes (since LibPQ already added them), it returns a
  `BSB.Builder` nonetheless to maintain symmetry with `quoteStringLiteral`.

@since 1.0.0.0
-}
quoteIdentifier :: Connection -> BS.ByteString -> IO BSB.Builder
quoteIdentifier :: Connection -> ByteString -> IO Builder
quoteIdentifier Connection
connection ByteString
unquotedString = do
  Connection
libPQConn <- Connection -> IO Connection
readLibPQConnectionOrFailIfClosed Connection
connection
  Maybe ByteString
mbEscapedString <- Connection -> ByteString -> IO (Maybe ByteString)
LibPQ.escapeIdentifier Connection
libPQConn ByteString
unquotedString

  case Maybe ByteString
mbEscapedString of
    Maybe ByteString
Nothing ->
      String -> Connection -> IO Builder
forall a. String -> Connection -> IO a
throwConnectionError String
"Error while escaping identifier" Connection
libPQConn
    Just ByteString
quotedString ->
      Builder -> IO Builder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Builder
BSB.byteString ByteString
quotedString)

readLibPQConnectionOrFailIfClosed :: Connection -> IO LibPQ.Connection
readLibPQConnectionOrFailIfClosed :: Connection -> IO Connection
readLibPQConnectionOrFailIfClosed (Connection MVar Connection
handle) = do
  Maybe Connection
mbConn <- MVar Connection -> IO (Maybe Connection)
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar Connection
handle

  case Maybe Connection
mbConn of
    Maybe Connection
Nothing ->
      ConnectionUsedAfterCloseError -> IO Connection
forall e a. Exception e => e -> IO a
throwIO ConnectionUsedAfterCloseError
ConnectionUsedAfterCloseError
    Just Connection
conn ->
      Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
conn

throwConnectionError :: String -> LibPQ.Connection -> IO a
throwConnectionError :: forall a. String -> Connection -> IO a
throwConnectionError String
message Connection
conn = do
  Maybe ByteString
mbLibPQError <- Connection -> IO (Maybe ByteString)
LibPQ.errorMessage Connection
conn

  ConnectionError -> IO a
forall e a. Exception e => e -> IO a
throwIO (ConnectionError -> IO a) -> ConnectionError -> IO a
forall a b. (a -> b) -> a -> b
$
    ConnectionError
      { connectionErrorMessage :: String
connectionErrorMessage = String
message
      , connectionErrorLibPQMessage :: Maybe ByteString
connectionErrorLibPQMessage = Maybe ByteString
mbLibPQError
      }

throwExecutionErrorWithoutResult ::
  LibPQ.Connection ->
  BS.ByteString ->
  IO a
throwExecutionErrorWithoutResult :: forall a. Connection -> ByteString -> IO a
throwExecutionErrorWithoutResult Connection
conn ByteString
queryBS = do
  Maybe ByteString
mbLibPQError <- Connection -> IO (Maybe ByteString)
LibPQ.errorMessage Connection
conn

  SqlExecutionError -> IO a
forall e a. Exception e => e -> IO a
throwIO (SqlExecutionError -> IO a) -> SqlExecutionError -> IO a
forall a b. (a -> b) -> a -> b
$
    SqlExecutionError
      { sqlExecutionErrorExecStatus :: Maybe ExecStatus
sqlExecutionErrorExecStatus = Maybe ExecStatus
forall a. Maybe a
Nothing
      , sqlExecutionErrorMessage :: ByteString
sqlExecutionErrorMessage = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> ByteString
B8.pack String
"No error message available from LibPQ") Maybe ByteString
mbLibPQError
      , sqlExecutionErrorSqlState :: Maybe ByteString
sqlExecutionErrorSqlState = Maybe ByteString
forall a. Maybe a
Nothing
      , sqlExecutionErrorSqlQuery :: ByteString
sqlExecutionErrorSqlQuery = ByteString
queryBS
      }

throwExecutionErrorWithResult ::
  LibPQ.Result ->
  LibPQ.ExecStatus ->
  BS.ByteString ->
  IO a
throwExecutionErrorWithResult :: forall a. Result -> ExecStatus -> ByteString -> IO a
throwExecutionErrorWithResult Result
result ExecStatus
execStatus ByteString
queryBS = do
  Maybe ByteString
mbLibPQError <- Result -> IO (Maybe ByteString)
LibPQ.resultErrorMessage Result
result
  Maybe ByteString
mbSqlState <- Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagSqlstate

  SqlExecutionError -> IO a
forall e a. Exception e => e -> IO a
throwIO (SqlExecutionError -> IO a) -> SqlExecutionError -> IO a
forall a b. (a -> b) -> a -> b
$
    SqlExecutionError
      { sqlExecutionErrorExecStatus :: Maybe ExecStatus
sqlExecutionErrorExecStatus = ExecStatus -> Maybe ExecStatus
forall a. a -> Maybe a
Just ExecStatus
execStatus
      , sqlExecutionErrorMessage :: ByteString
sqlExecutionErrorMessage = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> ByteString
B8.pack String
"No error message available from LibPQ") Maybe ByteString
mbLibPQError
      , sqlExecutionErrorSqlState :: Maybe ByteString
sqlExecutionErrorSqlState = Maybe ByteString
mbSqlState
      , sqlExecutionErrorSqlQuery :: ByteString
sqlExecutionErrorSqlQuery = ByteString
queryBS
      }

isRowReadableStatus :: LibPQ.ExecStatus -> Bool
isRowReadableStatus :: ExecStatus -> Bool
isRowReadableStatus ExecStatus
status =
  case ExecStatus
status of
    ExecStatus
LibPQ.CommandOk -> Bool
True -- ??
    ExecStatus
LibPQ.TuplesOk -> Bool
True -- Returned on successful query, even if there are 0 rows.
    ExecStatus
LibPQ.SingleTuple -> Bool
True -- Only returned when a query is executed is single row mode
    ExecStatus
LibPQ.EmptyQuery -> Bool
False
    ExecStatus
LibPQ.CopyOut -> Bool
False
    ExecStatus
LibPQ.CopyIn -> Bool
False
    ExecStatus
LibPQ.CopyBoth -> Bool
False -- CopyBoth is only used for streaming replication, so should not occur in ordinary applications
    ExecStatus
LibPQ.BadResponse -> Bool
False
    ExecStatus
LibPQ.NonfatalError -> Bool
False -- NonfatalError never returned from LibPQ query execution functions. It passes them to the notice processor instead.
    ExecStatus
LibPQ.FatalError -> Bool
False

{- |
  Packages a bytestring parameter value (which is assumed to be a value encoded
  as text that the database can use) as a parameter for executing a query.
  This uses Oid 0 to cause the database to infer the type of the paremeter and
  explicitly marks the parameter as being in Text format.

@since 1.0.0.0
-}
mkInferredTextParam :: Maybe BS.ByteString -> Maybe (LibPQ.Oid, BS.ByteString, LibPQ.Format)
mkInferredTextParam :: Maybe ByteString -> Maybe (Oid, ByteString, Format)
mkInferredTextParam Maybe ByteString
mbValue =
  case Maybe ByteString
mbValue of
    Maybe ByteString
Nothing ->
      Maybe (Oid, ByteString, Format)
forall a. Maybe a
Nothing
    Just ByteString
value ->
      (Oid, ByteString, Format) -> Maybe (Oid, ByteString, Format)
forall a. a -> Maybe a
Just (CUInt -> Oid
LibPQ.Oid CUInt
0, ByteString
value, Format
LibPQ.Text)

{- |
  Orville throws a 'ConnectionError' on an error reported by the underlying
  LibPQ connection that does not come directly from executing SQL. This could
  could represent an inability to open a new database connection, but could
  also represent other errors such as an error while quoting a database
  identifier.

@since 1.0.0.0
-}
data ConnectionError = ConnectionError
  { ConnectionError -> String
connectionErrorMessage :: String
  , ConnectionError -> Maybe ByteString
connectionErrorLibPQMessage :: Maybe BS.ByteString
  }

instance Show ConnectionError where
  show :: ConnectionError -> String
show ConnectionError
err =
    let
      libPQErrorMsg :: String
libPQErrorMsg =
        case ConnectionError -> Maybe ByteString
connectionErrorLibPQMessage ConnectionError
err of
          Maybe ByteString
Nothing ->
            String
"<no underying error available>"
          Just ByteString
libPQMsg ->
            case ByteString -> Either UnicodeException Text
Enc.decodeUtf8' ByteString
libPQMsg of
              Right Text
decoded ->
                Text -> String
T.unpack Text
decoded
              Left UnicodeException
decodingErr ->
                String
"Error decoding libPQ messages as utf8: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
decodingErr
    in
      ConnectionError -> String
connectionErrorMessage ConnectionError
err String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
libPQErrorMsg

instance Exception ConnectionError

{- |
  Orville throws a 'SqlExecutionError' when an error is reported by the
  underlying LibPQ connection during an attempt to execute SQL.

@since 1.0.0.0
-}
data SqlExecutionError = SqlExecutionError
  { SqlExecutionError -> Maybe ExecStatus
sqlExecutionErrorExecStatus :: Maybe LibPQ.ExecStatus
  -- ^ The underlying LibPQ execution status.
  , SqlExecutionError -> ByteString
sqlExecutionErrorMessage :: BS.ByteString
  -- ^ Error message reported by PostgreSQL.
  , SqlExecutionError -> Maybe ByteString
sqlExecutionErrorSqlState :: Maybe BS.ByteString
  -- ^ Any SQL state value reported by PostgreSQL. This can be used to
  -- determine what kind of error happened without needing to parse the error
  -- message. See
  -- https://www.postgresql.org/docs/current/errcodes-appendix.html.
  , SqlExecutionError -> ByteString
sqlExecutionErrorSqlQuery :: BS.ByteString
  -- ^ The SQL query that was being run when the error occurred.
  }
  deriving (Int -> SqlExecutionError -> String -> String
[SqlExecutionError] -> String -> String
SqlExecutionError -> String
(Int -> SqlExecutionError -> String -> String)
-> (SqlExecutionError -> String)
-> ([SqlExecutionError] -> String -> String)
-> Show SqlExecutionError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SqlExecutionError -> String -> String
showsPrec :: Int -> SqlExecutionError -> String -> String
$cshow :: SqlExecutionError -> String
show :: SqlExecutionError -> String
$cshowList :: [SqlExecutionError] -> String -> String
showList :: [SqlExecutionError] -> String -> String
Show)

instance Exception SqlExecutionError

{- |
  Orville throws as 'ConnectionUsedAfterCloseError' if it attempts to use a
  'Connection' value after it has already been closed. If this occurs, it is a
  bug in Orville.

@since 1.0.0.0
-}
data ConnectionUsedAfterCloseError
  = ConnectionUsedAfterCloseError
  deriving (Int -> ConnectionUsedAfterCloseError -> String -> String
[ConnectionUsedAfterCloseError] -> String -> String
ConnectionUsedAfterCloseError -> String
(Int -> ConnectionUsedAfterCloseError -> String -> String)
-> (ConnectionUsedAfterCloseError -> String)
-> ([ConnectionUsedAfterCloseError] -> String -> String)
-> Show ConnectionUsedAfterCloseError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ConnectionUsedAfterCloseError -> String -> String
showsPrec :: Int -> ConnectionUsedAfterCloseError -> String -> String
$cshow :: ConnectionUsedAfterCloseError -> String
show :: ConnectionUsedAfterCloseError -> String
$cshowList :: [ConnectionUsedAfterCloseError] -> String -> String
showList :: [ConnectionUsedAfterCloseError] -> String -> String
Show)

instance Exception ConnectionUsedAfterCloseError