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

import Hasql.Commands qualified as Commands
import Hasql.Decoders.Result qualified as ResultDecoders
import Hasql.Decoders.Results qualified as ResultsDecoders
import Hasql.Encoders.Params qualified as ParamsEncoders
import Hasql.Errors
import Hasql.LibPq14 qualified as LibPQ
import Hasql.Prelude
import Hasql.PreparedStatementRegistry qualified 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 -> Maybe (Maybe ByteString) -> IO (Maybe (Maybe ByteString))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe ByteString)
forall a. Maybe a
Nothing
      ConnStatus
_ -> (Maybe ByteString -> Maybe (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe (Maybe ByteString))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ByteString -> Maybe (Maybe ByteString)
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 =
  (Int -> Maybe Int) -> IO Int -> IO (Maybe Int)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Bool) -> Maybe Int -> Maybe Int
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
80200) (Maybe Int -> Maybe Int) -> (Int -> Maybe Int) -> Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Maybe Int
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 =
  (Maybe ByteString -> Bool) -> IO (Maybe ByteString) -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ByteString -> Bool
forall {a}. (Eq a, IsString a) => Maybe a -> Bool
decodeValue (IO (Maybe ByteString) -> IO Bool)
-> IO (Maybe ByteString) -> IO Bool
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 =
  IO (Maybe Result) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe Result) -> IO ()) -> IO (Maybe Result) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO (Maybe Result)
LibPQ.exec Connection
c (Commands -> ByteString
Commands.asBytes (Commands
Commands.setEncodersToUTF8 Commands -> Commands -> Commands
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" #-}
  Either CommandError a
-> Either CommandError () -> Either CommandError a
forall a b.
Either CommandError a
-> Either CommandError b -> Either CommandError a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*) (Either CommandError a
 -> Either CommandError () -> Either CommandError a)
-> IO (Either CommandError a)
-> IO (Either CommandError () -> Either CommandError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either CommandError a)
get IO (Either CommandError () -> Either CommandError a)
-> IO (Either CommandError ()) -> IO (Either CommandError a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Either CommandError ())
dropRemainders
  where
    get :: IO (Either CommandError a)
get =
      Results a -> Connection -> Bool -> IO (Either CommandError a)
forall a.
Results a -> Connection -> Bool -> IO (Either CommandError a)
ResultsDecoders.run Results a
decoder Connection
connection Bool
integerDatetimes
    dropRemainders :: IO (Either CommandError ())
dropRemainders =
      Results () -> Connection -> Bool -> IO (Either CommandError ())
forall a.
Results a -> Connection -> Bool -> IO (Either CommandError a)
ResultsDecoders.run Results ()
ResultsDecoders.dropRemainders Connection
connection Bool
integerDatetimes

{-# 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" #-}
  LocalKey
-> (ByteString -> IO (Bool, Either CommandError ByteString))
-> (ByteString -> IO (Either CommandError ByteString))
-> PreparedStatementRegistry
-> IO (Either CommandError ByteString)
forall a.
LocalKey
-> (ByteString -> IO (Bool, a))
-> (ByteString -> IO a)
-> PreparedStatementRegistry
-> IO a
PreparedStatementRegistry.update LocalKey
localKey ByteString -> IO (Bool, Either CommandError ByteString)
onNewRemoteKey ByteString -> IO (Either CommandError ByteString)
forall {f :: * -> *} {f :: * -> *} {a}.
(Applicative f, Applicative f) =>
a -> f (f a)
onOldRemoteKey PreparedStatementRegistry
registry
  where
    localKey :: LocalKey
localKey =
      ByteString -> [Oid] -> LocalKey
PreparedStatementRegistry.LocalKey ByteString
template [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 (([Oid] -> Bool) -> Maybe [Oid] -> Maybe [Oid]
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not (Bool -> Bool) -> ([Oid] -> Bool) -> [Oid] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Oid] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([Oid] -> Maybe [Oid]
forall a. a -> Maybe a
Just [Oid]
oidList))
        (Either CommandError () -> (Bool, Either CommandError ByteString))
-> IO (Either CommandError ())
-> IO (Bool, Either CommandError ByteString)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either CommandError () -> (Bool, Either CommandError ByteString)
resultsMapping (IO (Either CommandError ())
 -> IO (Bool, Either CommandError ByteString))
-> IO (Either CommandError ())
-> IO (Bool, Either CommandError ByteString)
forall a b. (a -> b) -> a -> b
$ Connection -> Bool -> Results () -> IO (Either CommandError ())
forall a.
Connection -> Bool -> Results a -> IO (Either CommandError a)
getResults Connection
connection Bool
forall a. HasCallStack => a
undefined (Bool -> Results ()
resultsDecoder Bool
sent)
      where
        resultsDecoder :: Bool -> Results ()
resultsDecoder Bool
sent =
          if Bool
sent
            then Result () -> Results ()
forall a. Result a -> Results a
ResultsDecoders.single Result ()
ResultDecoders.noResult
            else Results ()
forall a. Results a
ResultsDecoders.clientError
        resultsMapping :: Either CommandError () -> (Bool, Either CommandError ByteString)
resultsMapping =
          \case
            Left CommandError
x -> (Bool
False, CommandError -> Either CommandError ByteString
forall a b. a -> Either a b
Left CommandError
x)
            Right ()
_ -> (Bool
True, ByteString -> Either CommandError ByteString
forall a b. b -> Either a b
Right ByteString
key)
    onOldRemoteKey :: a -> f (f a)
onOldRemoteKey a
key =
      f a -> f (f a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a
forall a. a -> f a
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 IO Bool
-> (Bool -> IO (Either CommandError ()))
-> IO (Either CommandError ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> (Maybe ByteString -> Either CommandError ())
-> IO (Maybe ByteString) -> IO (Either CommandError ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CommandError -> Either CommandError ()
forall a b. a -> Either a b
Left (CommandError -> Either CommandError ())
-> (Maybe ByteString -> CommandError)
-> Maybe ByteString
-> Either CommandError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
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) (IO (Maybe ByteString) -> IO (Either CommandError ()))
-> IO (Maybe ByteString) -> IO (Either CommandError ())
forall a b. (a -> b) -> a -> b
$ Connection -> IO (Maybe ByteString)
LibPQ.errorMessage Connection
connection
    Bool
True -> Either CommandError () -> IO (Either CommandError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either CommandError ()
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 Params a
encoder a
input =
  ExceptT CommandError IO () -> IO (Either CommandError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CommandError IO () -> IO (Either CommandError ()))
-> ExceptT CommandError IO () -> IO (Either CommandError ())
forall a b. (a -> b) -> a -> b
$ do
    ByteString
key <- IO (Either CommandError ByteString)
-> ExceptT CommandError IO ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either CommandError ByteString)
 -> ExceptT CommandError IO ByteString)
-> IO (Either CommandError ByteString)
-> ExceptT CommandError IO ByteString
forall a b. (a -> b) -> a -> b
$ Connection
-> PreparedStatementRegistry
-> ByteString
-> [Oid]
-> IO (Either CommandError ByteString)
getPreparedStatementKey Connection
connection PreparedStatementRegistry
registry ByteString
template [Oid]
oidList
    IO (Either CommandError ()) -> ExceptT CommandError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either CommandError ()) -> ExceptT CommandError IO ())
-> IO (Either CommandError ()) -> ExceptT CommandError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO Bool -> IO (Either CommandError ())
checkedSend Connection
connection (IO Bool -> IO (Either CommandError ()))
-> IO Bool -> IO (Either CommandError ())
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
  where
    ([Oid]
oidList, [Maybe (ByteString, Format)]
valueAndFormatList) =
      Params a -> Bool -> a -> ([Oid], [Maybe (ByteString, Format)])
forall a.
Params a -> Bool -> a -> ([Oid], [Maybe (ByteString, Format)])
ParamsEncoders.compilePreparedStatementData Params a
encoder Bool
integerDatetimes a
input

{-# 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 Params a
encoder a
input =
  Connection -> IO Bool -> IO (Either CommandError ())
checkedSend Connection
connection
    (IO Bool -> IO (Either CommandError ()))
-> IO Bool -> IO (Either CommandError ())
forall a b. (a -> b) -> a -> b
$ Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO Bool
LibPQ.sendQueryParams
      Connection
connection
      ByteString
template
      (Params a -> Bool -> a -> [Maybe (Oid, ByteString, Format)]
forall a.
Params a -> Bool -> a -> [Maybe (Oid, ByteString, Format)]
ParamsEncoders.compileUnpreparedStatementData Params a
encoder Bool
integerDatetimes a
input)
      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 Connection
-> PreparedStatementRegistry
-> Bool
-> ByteString
-> Params a
-> a
-> IO (Either CommandError ())
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 Connection
-> Bool
-> ByteString
-> Params a
-> a
-> IO (Either CommandError ())
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 (IO Bool -> IO (Either CommandError ()))
-> IO Bool -> IO (Either CommandError ())
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO Bool
LibPQ.sendQuery Connection
connection ByteString
sql