Functions.hs

module Database.PostgreSQL.Query.Functions
       ( -- * Raw query execution
         pgQuery
       , pgQueryWithMasker
       , pgExecute
       , pgExecuteWithMasker
         -- * Transactions
       , pgWithTransaction
       , pgWithSavepoint
       , pgWithTransactionMode
       , pgWithTransactionModeRetry
       , pgWithTransactionSerializable
         -- * Auxiliary
       , pgRepsertRow
       ) where

import Data.Int ( Int64 )
import Database.PostgreSQL.Query.Import
import Database.PostgreSQL.Query.Internal
import Database.PostgreSQL.Query.SqlBuilder
import Database.PostgreSQL.Query.TH
import Database.PostgreSQL.Query.Types
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.Transaction

import qualified Data.Text.Encoding as T

{- | Execute query generated by 'SqlBuilder'. Typical use case:

@
let userName = "Vovka Erohin" :: Text
pgQuery [sqlExp| SELECT id, name FROM users WHERE name = #{userName}|]
@

Or

@
let userName = "Vovka Erohin" :: Text
pgQuery $ Qp "SELECT id, name FROM users WHERE name = ?" [userName]
@

Which is almost the same. In both cases proper value escaping is performed
so you stay protected from sql injections.

-}

pgQuery
  :: (MonadPostgres m, ToSqlBuilder q, FromRow r, HasCallStack)
  => q
  -> m [r]
pgQuery = withFrozenCallStack $ pgQueryWithMasker defaultLogMasker

-- | Execute arbitrary query and return count of affected rows
pgExecute
  :: (MonadPostgres m, ToSqlBuilder q, HasCallStack)
  => q
  -> m Int64
pgExecute = withFrozenCallStack $ pgExecuteWithMasker defaultLogMasker

pgQueryWithMasker
  :: (MonadPostgres m, ToSqlBuilder q, FromRow r, HasCallStack)
  => LogMasker
  -> q
  -> m [r]
pgQueryWithMasker masker q = withFrozenCallStack $ withPGConnection $ \c -> do
    (queryBs, logBs) <- liftBase $ runSqlBuilder c masker $ toSqlBuilder q
    logDebug $ T.decodeUtf8 logBs
    liftBase $ query_ c queryBs

pgExecuteWithMasker
  :: (MonadPostgres m, ToSqlBuilder q, HasCallStack)
  => LogMasker
  -> q
  -> m Int64
pgExecuteWithMasker masker q = withFrozenCallStack $ withPGConnection $ \c -> do
    (queryBs, logBs) <- liftBase $ runSqlBuilder c masker $ toSqlBuilder q
    logDebug $ T.decodeUtf8 logBs
    liftBase $ execute_ c queryBs

-- | Execute all queries inside one transaction. Rollback transaction on exceptions
pgWithTransaction
  :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m, HasCallStack)
  => (HasCallStack => m a)
  -> m a
pgWithTransaction action = withPGConnection $ \con -> do
    control $ \runInIO -> do
        withTransaction con $ runInIO action

-- | Same as `pgWithTransaction` but executes queries inside savepoint
pgWithSavepoint
  :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m, HasCallStack)
  => (HasCallStack => m a)
  -> m a
pgWithSavepoint action = withPGConnection $ \con -> do
    control $ \runInIO -> do
        withSavepoint con $ runInIO action

-- | Wrapper for 'withTransactionMode': Execute an action inside a SQL
-- transaction with a given transaction mode.
pgWithTransactionMode
  :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m, HasCallStack)
  => TransactionMode
  -> (HasCallStack => m a)
  -> m a
pgWithTransactionMode tmode ma = withPGConnection $ \con -> do
    control $ \runInIO -> do
        withTransactionMode tmode con $ runInIO ma

-- | Wrapper for 'withTransactionModeRetry': Like 'pgWithTransactionMode',
-- but also takes a custom callback to determine if a transaction
-- should be retried if an SqlError occurs. If the callback returns
-- True, then the transaction will be retried. If the callback returns
-- False, or an exception other than an SqlError occurs then the
-- transaction will be rolled back and the exception rethrown.
pgWithTransactionModeRetry
  :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m, HasCallStack)
  => TransactionMode
  -> (SqlError -> Bool)
  -> (HasCallStack => m a)
  -> m a
pgWithTransactionModeRetry tmode epred ma = withPGConnection $ \con -> do
    control $ \runInIO -> do
        withTransactionModeRetry tmode epred con $ runInIO ma

-- | Wrapper for 'withTransactionSerializable': Execute an action
-- inside of a 'Serializable' transaction. If a serialization failure
-- occurs, roll back the transaction and try again. Be warned that
-- this may execute the IO action multiple times.
--
-- A Serializable transaction creates the illusion that your program
-- has exclusive access to the database. This means that, even in a
-- concurrent setting, you can perform queries in sequence without
-- having to worry about what might happen between one statement and
-- the next.
pgWithTransactionSerializable
  :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)
  => (HasCallStack => m a)
  -> m a
pgWithTransactionSerializable ma = withPGConnection $ \con -> do
    control $ \runInIO -> do
        withTransactionSerializable con $ runInIO ma



{- | Perform repsert of the same row, first trying "update where" then
"insert" with concatenated fields. Which means that if you run

@
pgRepsertRow "emails" (MR [("user_id", mkValue uid)]) (MR [("email", mkValue email)])
@

Then firstly will be performed

@
UPDATE "emails" SET email = 'foo@bar.com' WHERE "user_id" = 1234
@

And if no one row is affected (which is returned by 'pgExecute'), then

@
INSERT INTO "emails" ("user_id", "email") VALUES (1234, 'foo@bar.com')
@

will be performed

-}

pgRepsertRow
  :: ( MonadPostgres m, MonadLogger m
     , ToMarkedRow wrow, ToMarkedRow urow, HasCallStack)
  => FN                         -- ^ Table name
  -> wrow                       -- ^ where condition
  -> urow                       -- ^ update row
  -> m ()
pgRepsertRow tname wrow urow = do
    let wmr = toMarkedRow wrow
    aff <- pgExecute $ updateTable tname urow
           [sqlExp|WHERE ^{mrToBuilder "AND" wmr}|]
    when (aff == 0) $ do
        let umr = toMarkedRow urow
            imr = wmr <> umr
        _ <- pgExecute $ insertInto tname imr
        return ()