{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Every hasql version difference that arbiter-hasql depends on.
module Arbiter.Hasql.Compat
  ( runSQL
  , connectionInTransaction
  , withHasqlLibPQConnection
  , hasqlSettings
  , HasqlSettings
  ) where

import Arbiter.Core.Exceptions (throwInternal)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Text.Encoding.Error qualified as TE
import Database.PostgreSQL.LibPQ qualified as LibPQ
import Hasql.Connection qualified as Hasql
import Hasql.Session qualified as Session
import UnliftIO (MonadUnliftIO)

#if MIN_VERSION_hasql(1,10,0)
import Hasql.Connection.Settings qualified as Settings
#else
import Hasql.Connection.Setting qualified as Setting
import Hasql.Connection.Setting.Connection qualified as ConnSetting
#endif

-- | Run a bare SQL command, such as @BEGIN@ or @COMMIT@.
runSQL :: (MonadUnliftIO m) => Hasql.Connection -> ByteString -> m ()
runSQL :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m ()
runSQL Connection
conn ByteString
sql =
  IO (Either SessionError ()) -> m (Either SessionError ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> Session () -> IO (Either SessionError ())
forall a. Connection -> Session a -> IO (Either SessionError a)
Hasql.use Connection
conn (Text -> Session ()
runScript (OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TE.lenientDecode ByteString
sql)))
    m (Either SessionError ())
-> (Either SessionError () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SessionError -> m ())
-> (() -> m ()) -> Either SessionError () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\SessionError
err -> Text -> m ()
forall (m :: * -> *) a. MonadIO m => Text -> m a
throwInternal (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"hasql runSQL error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SessionError -> String
forall a. Show a => a -> String
show SessionError
err)) () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

#if MIN_VERSION_hasql(1,10,0)
runScript :: T.Text -> Session.Session ()
runScript :: Text -> Session ()
runScript = Text -> Session ()
Session.script
#else
runScript :: T.Text -> Session.Session ()
runScript = Session.sql
#endif

-- | Whether the connection is in a transaction block, valid or aborted.
connectionInTransaction :: Hasql.Connection -> IO Bool
#if MIN_VERSION_hasql(1,10,0)
connectionInTransaction :: Connection -> IO Bool
connectionInTransaction Connection
conn = do
  result <- Connection -> Session Bool -> IO (Either SessionError Bool)
forall a. Connection -> Session a -> IO (Either SessionError a)
Hasql.use Connection
conn (Session Bool -> IO (Either SessionError Bool))
-> Session Bool -> IO (Either SessionError Bool)
forall a b. (a -> b) -> a -> b
$ (Connection -> IO (Either SessionError Bool, Connection))
-> Session Bool
forall a.
(Connection -> IO (Either SessionError a, Connection)) -> Session a
Session.onLibpqConnection ((Connection -> IO (Either SessionError Bool, Connection))
 -> Session Bool)
-> (Connection -> IO (Either SessionError Bool, Connection))
-> Session Bool
forall a b. (a -> b) -> a -> b
$ \Connection
libpq -> do
    status <- Connection -> IO TransactionStatus
LibPQ.transactionStatus Connection
libpq
    pure (Right (txStatusNeedsRollback status), libpq)
  case result of
    Right Bool
inTx -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
inTx
    Left SessionError
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
#else
connectionInTransaction conn =
  Hasql.withLibPQConnection conn $ \libpq -> do
    status <- LibPQ.transactionStatus libpq
    pure (txStatusNeedsRollback status)
#endif

-- | Run an action with the underlying libpq connection, for LISTEN/NOTIFY.
withHasqlLibPQConnection :: Hasql.Connection -> (LibPQ.Connection -> IO a) -> IO a
#if MIN_VERSION_hasql(1,10,0)
withHasqlLibPQConnection :: forall a. Connection -> (Connection -> IO a) -> IO a
withHasqlLibPQConnection Connection
conn Connection -> IO a
action = do
  result <- Connection -> Session a -> IO (Either SessionError a)
forall a. Connection -> Session a -> IO (Either SessionError a)
Hasql.use Connection
conn (Session a -> IO (Either SessionError a))
-> Session a -> IO (Either SessionError a)
forall a b. (a -> b) -> a -> b
$ (Connection -> IO (Either SessionError a, Connection)) -> Session a
forall a.
(Connection -> IO (Either SessionError a, Connection)) -> Session a
Session.onLibpqConnection ((Connection -> IO (Either SessionError a, Connection))
 -> Session a)
-> (Connection -> IO (Either SessionError a, Connection))
-> Session a
forall a b. (a -> b) -> a -> b
$ \Connection
libpq -> do
    actionResult <- Connection -> IO a
action Connection
libpq
    pure (Right actionResult, libpq)
  either (const (throwInternal "connection lost")) pure result
#else
withHasqlLibPQConnection = Hasql.withLibPQConnection
#endif

-- | @TransInTrans@ and @TransInError@ accept a @ROLLBACK@ without warning.
txStatusNeedsRollback :: LibPQ.TransactionStatus -> Bool
txStatusNeedsRollback :: TransactionStatus -> Bool
txStatusNeedsRollback TransactionStatus
LibPQ.TransInTrans = Bool
True
txStatusNeedsRollback TransactionStatus
LibPQ.TransInError = Bool
True
txStatusNeedsRollback TransactionStatus
_ = Bool
False

#if MIN_VERSION_hasql(1,10,0)
-- | Connection settings, whose representation follows the hasql version.
type HasqlSettings = Settings.Settings

-- | Convert a connection string ByteString to hasql settings.
hasqlSettings :: ByteString -> HasqlSettings
hasqlSettings :: ByteString -> HasqlSettings
hasqlSettings = Text -> HasqlSettings
Settings.connectionString (Text -> HasqlSettings)
-> (ByteString -> Text) -> ByteString -> HasqlSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TE.lenientDecode
#else
-- | Connection settings, whose representation follows the hasql version.
type HasqlSettings = [Setting.Setting]

-- | Convert a connection string ByteString to hasql settings.
hasqlSettings :: ByteString -> HasqlSettings
hasqlSettings connStr = [Setting.connection (ConnSetting.string (TE.decodeUtf8With TE.lenientDecode connStr))]
#endif