-- |
-- An API of low-level IO operations.
module Hasql.Private.IO where

import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.Private.Commands as Commands
import qualified Hasql.Private.Decoders.Result as ResultDecoders
import qualified Hasql.Private.Decoders.Results as ResultsDecoders
import qualified Hasql.Private.Encoders.Params as ParamsEncoders
import Hasql.Private.Errors
import Hasql.Private.Prelude
import qualified Hasql.Private.PreparedStatementRegistry as PreparedStatementRegistry

{-# INLINE acquireConnection #-}
acquireConnection :: ByteString -> IO LibPQ.Connection
acquireConnection :: ByteString -> IO Connection
acquireConnection =
  ByteString -> IO Connection
LibPQ.connectdb

{-# INLINE acquirePreparedStatementRegistry #-}
acquirePreparedStatementRegistry :: IO PreparedStatementRegistry.PreparedStatementRegistry
acquirePreparedStatementRegistry :: IO PreparedStatementRegistry
acquirePreparedStatementRegistry =
  IO PreparedStatementRegistry
PreparedStatementRegistry.new

{-# INLINE releaseConnection #-}
releaseConnection :: LibPQ.Connection -> IO ()
releaseConnection :: Connection -> IO ()
releaseConnection Connection
connection =
  Connection -> IO ()
LibPQ.finish Connection
connection

{-# INLINE checkConnectionStatus #-}
checkConnectionStatus :: LibPQ.Connection -> IO (Maybe (Maybe ByteString))
checkConnectionStatus :: Connection -> IO (Maybe (Maybe ByteString))
checkConnectionStatus Connection
c =
  do
    ConnStatus
s <- Connection -> IO ConnStatus
LibPQ.status Connection
c
    case ConnStatus
s of
      ConnStatus
LibPQ.ConnectionOk -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      ConnStatus
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (Connection -> IO (Maybe ByteString)
LibPQ.errorMessage Connection
c)

{-# INLINE checkServerVersion #-}
checkServerVersion :: LibPQ.Connection -> IO (Maybe Int)
checkServerVersion :: Connection -> IO (Maybe Int)
checkServerVersion Connection
c =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (forall a. Ord a => a -> a -> Bool
< Int
80200) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just) (Connection -> IO Int
LibPQ.serverVersion Connection
c)

{-# INLINE getIntegerDatetimes #-}
getIntegerDatetimes :: LibPQ.Connection -> IO Bool
getIntegerDatetimes :: Connection -> IO Bool
getIntegerDatetimes Connection
c =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. (Eq a, IsString a) => Maybe a -> Bool
decodeValue forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO (Maybe ByteString)
LibPQ.parameterStatus Connection
c ByteString
"integer_datetimes"
  where
    decodeValue :: Maybe a -> Bool
decodeValue =
      \case
        Just a
"on" -> Bool
True
        Maybe a
_ -> Bool
False

{-# INLINE initConnection #-}
initConnection :: LibPQ.Connection -> IO ()
initConnection :: Connection -> IO ()
initConnection Connection
c =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO (Maybe Result)
LibPQ.exec Connection
c (Commands -> ByteString
Commands.asBytes (Commands
Commands.setEncodersToUTF8 forall a. Semigroup a => a -> a -> a
<> Commands
Commands.setMinClientMessagesToWarning))

{-# INLINE getResults #-}
getResults :: LibPQ.Connection -> Bool -> ResultsDecoders.Results a -> IO (Either CommandError a)
getResults :: forall a.
Connection -> Bool -> Results a -> IO (Either CommandError a)
getResults Connection
connection Bool
integerDatetimes Results a
decoder =
  {-# SCC "getResults" #-}
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either CommandError a)
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Either CommandError ())
dropRemainders
  where
    get :: IO (Either CommandError a)
get =
      forall a.
Results a -> (Bool, Connection) -> IO (Either CommandError a)
ResultsDecoders.run Results a
decoder (Bool
integerDatetimes, Connection
connection)
    dropRemainders :: IO (Either CommandError ())
dropRemainders =
      forall a.
Results a -> (Bool, Connection) -> IO (Either CommandError a)
ResultsDecoders.run Results ()
ResultsDecoders.dropRemainders (Bool
integerDatetimes, Connection
connection)

{-# INLINE getPreparedStatementKey #-}
getPreparedStatementKey ::
  LibPQ.Connection ->
  PreparedStatementRegistry.PreparedStatementRegistry ->
  ByteString ->
  [LibPQ.Oid] ->
  IO (Either CommandError ByteString)
getPreparedStatementKey :: Connection
-> PreparedStatementRegistry
-> ByteString
-> [Oid]
-> IO (Either CommandError ByteString)
getPreparedStatementKey Connection
connection PreparedStatementRegistry
registry ByteString
template [Oid]
oidList =
  {-# SCC "getPreparedStatementKey" #-}
  forall a.
LocalKey
-> (ByteString -> IO (Bool, a))
-> (ByteString -> IO a)
-> PreparedStatementRegistry
-> IO a
PreparedStatementRegistry.update LocalKey
localKey ByteString -> IO (Bool, Either CommandError ByteString)
onNewRemoteKey forall {f :: * -> *} {f :: * -> *} {a}.
(Applicative f, Applicative f) =>
a -> f (f a)
onOldRemoteKey PreparedStatementRegistry
registry
  where
    localKey :: LocalKey
localKey =
      ByteString -> [Word32] -> LocalKey
PreparedStatementRegistry.LocalKey ByteString
template [Word32]
wordOIDList
      where
        wordOIDList :: [Word32]
wordOIDList =
          forall a b. (a -> b) -> [a] -> [b]
map (\(LibPQ.Oid CUInt
x) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
x) [Oid]
oidList
    onNewRemoteKey :: ByteString -> IO (Bool, Either CommandError ByteString)
onNewRemoteKey ByteString
key =
      do
        Bool
sent <- Connection -> ByteString -> ByteString -> Maybe [Oid] -> IO Bool
LibPQ.sendPrepare Connection
connection ByteString
key ByteString
template (forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (forall a. a -> Maybe a
Just [Oid]
oidList))
        let resultsDecoder :: Results ()
resultsDecoder =
              if Bool
sent
                then forall a. Result a -> Results a
ResultsDecoders.single Result ()
ResultDecoders.noResult
                else forall a. Results a
ResultsDecoders.clientError
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either CommandError () -> (Bool, Either CommandError ByteString)
resultsMapping forall a b. (a -> b) -> a -> b
$ forall a.
Connection -> Bool -> Results a -> IO (Either CommandError a)
getResults Connection
connection forall a. HasCallStack => a
undefined Results ()
resultsDecoder
      where
        resultsMapping :: Either CommandError () -> (Bool, Either CommandError ByteString)
resultsMapping =
          \case
            Left CommandError
x -> (Bool
False, forall a b. a -> Either a b
Left CommandError
x)
            Right ()
_ -> (Bool
True, forall a b. b -> Either a b
Right ByteString
key)
    onOldRemoteKey :: a -> f (f a)
onOldRemoteKey a
key =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
key)

{-# INLINE checkedSend #-}
checkedSend :: LibPQ.Connection -> IO Bool -> IO (Either CommandError ())
checkedSend :: Connection -> IO Bool -> IO (Either CommandError ())
checkedSend Connection
connection IO Bool
send =
  IO Bool
send forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe ByteString -> CommandError
ClientError) forall a b. (a -> b) -> a -> b
$ Connection -> IO (Maybe ByteString)
LibPQ.errorMessage Connection
connection
    Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())

{-# INLINE sendPreparedParametricStatement #-}
sendPreparedParametricStatement ::
  LibPQ.Connection ->
  PreparedStatementRegistry.PreparedStatementRegistry ->
  Bool ->
  ByteString ->
  ParamsEncoders.Params a ->
  a ->
  IO (Either CommandError ())
sendPreparedParametricStatement :: forall a.
Connection
-> PreparedStatementRegistry
-> Bool
-> ByteString
-> Params a
-> a
-> IO (Either CommandError ())
sendPreparedParametricStatement Connection
connection PreparedStatementRegistry
registry Bool
integerDatetimes ByteString
template (ParamsEncoders.Params (Op a -> DList (Oid, Format, Bool -> Maybe ByteString, Text)
encoderOp)) a
input =
  let ([Oid]
oidList, [Maybe (ByteString, Format)]
valueAndFormatList) =
        let step :: (Oid, Format, Bool -> Maybe ByteString, Text)
-> ([Oid], [Maybe (ByteString, Format)])
-> ([Oid], [Maybe (ByteString, Format)])
step (Oid
oid, Format
format, Bool -> Maybe ByteString
encoder, Text
_) ~([Oid]
oidList, [Maybe (ByteString, Format)]
bytesAndFormatList) =
              (,)
                (Oid
oid forall a. a -> [a] -> [a]
: [Oid]
oidList)
                (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
bytes -> (ByteString
bytes, Format
format)) (Bool -> Maybe ByteString
encoder Bool
integerDatetimes) forall a. a -> [a] -> [a]
: [Maybe (ByteString, Format)]
bytesAndFormatList)
         in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Oid, Format, Bool -> Maybe ByteString, Text)
-> ([Oid], [Maybe (ByteString, Format)])
-> ([Oid], [Maybe (ByteString, Format)])
step ([], []) (a -> DList (Oid, Format, Bool -> Maybe ByteString, Text)
encoderOp a
input)
   in forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
        ByteString
key <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ Connection
-> PreparedStatementRegistry
-> ByteString
-> [Oid]
-> IO (Either CommandError ByteString)
getPreparedStatementKey Connection
connection PreparedStatementRegistry
registry ByteString
template [Oid]
oidList
        forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ Connection -> IO Bool -> IO (Either CommandError ())
checkedSend Connection
connection forall a b. (a -> b) -> a -> b
$ Connection
-> ByteString -> [Maybe (ByteString, Format)] -> Format -> IO Bool
LibPQ.sendQueryPrepared Connection
connection ByteString
key [Maybe (ByteString, Format)]
valueAndFormatList Format
LibPQ.Binary

{-# INLINE sendUnpreparedParametricStatement #-}
sendUnpreparedParametricStatement ::
  LibPQ.Connection ->
  Bool ->
  ByteString ->
  ParamsEncoders.Params a ->
  a ->
  IO (Either CommandError ())
sendUnpreparedParametricStatement :: forall a.
Connection
-> Bool
-> ByteString
-> Params a
-> a
-> IO (Either CommandError ())
sendUnpreparedParametricStatement Connection
connection Bool
integerDatetimes ByteString
template (ParamsEncoders.Params (Op a -> DList (Oid, Format, Bool -> Maybe ByteString, Text)
encoderOp)) a
input =
  let params :: [Maybe (Oid, ByteString, Format)]
params =
        let step :: (Oid, Format, Bool -> Maybe ByteString, Text)
-> [Maybe (Oid, ByteString, Format)]
-> [Maybe (Oid, ByteString, Format)]
step (Oid
oid, Format
format, Bool -> Maybe ByteString
encoder, Text
_) [Maybe (Oid, ByteString, Format)]
acc =
              ((,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure Oid
oid forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Maybe ByteString
encoder Bool
integerDatetimes forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
format) forall a. a -> [a] -> [a]
: [Maybe (Oid, ByteString, Format)]
acc
         in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Oid, Format, Bool -> Maybe ByteString, Text)
-> [Maybe (Oid, ByteString, Format)]
-> [Maybe (Oid, ByteString, Format)]
step [] (a -> DList (Oid, Format, Bool -> Maybe ByteString, Text)
encoderOp a
input)
   in Connection -> IO Bool -> IO (Either CommandError ())
checkedSend Connection
connection forall a b. (a -> b) -> a -> b
$ Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO Bool
LibPQ.sendQueryParams Connection
connection ByteString
template [Maybe (Oid, ByteString, Format)]
params Format
LibPQ.Binary

{-# INLINE sendParametricStatement #-}
sendParametricStatement ::
  LibPQ.Connection ->
  Bool ->
  PreparedStatementRegistry.PreparedStatementRegistry ->
  ByteString ->
  ParamsEncoders.Params a ->
  Bool ->
  a ->
  IO (Either CommandError ())
sendParametricStatement :: forall a.
Connection
-> Bool
-> PreparedStatementRegistry
-> ByteString
-> Params a
-> Bool
-> a
-> IO (Either CommandError ())
sendParametricStatement Connection
connection Bool
integerDatetimes PreparedStatementRegistry
registry ByteString
template Params a
encoder Bool
prepared a
params =
  {-# SCC "sendParametricStatement" #-}
  if Bool
prepared
    then forall a.
Connection
-> PreparedStatementRegistry
-> Bool
-> ByteString
-> Params a
-> a
-> IO (Either CommandError ())
sendPreparedParametricStatement Connection
connection PreparedStatementRegistry
registry Bool
integerDatetimes ByteString
template Params a
encoder a
params
    else forall a.
Connection
-> Bool
-> ByteString
-> Params a
-> a
-> IO (Either CommandError ())
sendUnpreparedParametricStatement Connection
connection Bool
integerDatetimes ByteString
template Params a
encoder a
params

{-# INLINE sendNonparametricStatement #-}
sendNonparametricStatement :: LibPQ.Connection -> ByteString -> IO (Either CommandError ())
sendNonparametricStatement :: Connection -> ByteString -> IO (Either CommandError ())
sendNonparametricStatement Connection
connection ByteString
sql =
  Connection -> IO Bool -> IO (Either CommandError ())
checkedSend Connection
connection forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO Bool
LibPQ.sendQuery Connection
connection ByteString
sql