-- | Exports a set of FFI-imported libpq/libpqtypes functions.
module Database.PostgreSQL.PQTypes.Internal.C.Interface (
  -- * libpq imports
    c_PQfreemem
  , c_PQstatus
  , c_PQerrorMessage
  , c_PQsetClientEncoding
  , c_PQsocket
  , c_PQconsumeInput
  , c_PQresultStatus
  , c_PQresultErrorField
  , c_PQresultErrorMessage
  , c_PQntuples
  , c_PQnfields
  , c_PQcmdTuples
  , c_PQgetisnull
  , c_PQfname
  , c_PQclear
  , c_PQcancel
  , c_PQconnectStart
  , c_PQconnectPoll
  , c_PQfinish
  -- * libpqtypes imports
  , c_PQinitTypes
  , c_PQregisterTypes
  , c_PQparamExec
  , c_PQparamPrepare
  , c_PQparamExecPrepared
  , c_PQparamCreate
  , c_PQparamClear
  , c_PQparamCount
  -- * misc imports
  , nullStringCStringLen
  )  where

import Foreign.C
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Ptr
import System.Posix.Types
import qualified Control.Exception as E

import Database.PostgreSQL.PQTypes.Internal.C.Types

----------------------------------------
-- PGconn

foreign import ccall unsafe "PQfreemem"
  c_PQfreemem :: Ptr a -> IO ()

foreign import ccall unsafe "PQstatus"
  c_PQstatus :: Ptr PGconn -> IO ConnStatusType

foreign import ccall unsafe "PQerrorMessage"
  c_PQerrorMessage :: Ptr PGconn -> IO CString

foreign import ccall unsafe "PQsocket"
  c_PQsocket :: Ptr PGconn -> IO Fd

-- | Safe as it sends a query to the server.
foreign import ccall safe "PQsetClientEncoding"
  c_PQsetClientEncoding :: Ptr PGconn -> CString -> IO CInt

-- | Safe as it reads data from a socket.
foreign import ccall safe "PQconsumeInput"
  c_PQconsumeInput :: Ptr PGconn -> IO CInt

-- | Safe as it might make a DNS lookup.
foreign import ccall safe "PQconnectStart"
  c_PQconnectStart :: CString -> IO (Ptr PGconn)

-- | Safe as it reads data from a socket.
foreign import ccall safe "PQconnectPoll"
  c_PQconnectPoll :: Ptr PGconn -> IO PostgresPollingStatusType

-- | Safe as it sends a terminate command to the server.
foreign import ccall safe "PQfinish"
  c_PQfinish :: Ptr PGconn -> IO ()

----------------------------------------
-- PGresult

foreign import ccall unsafe "PQresultStatus"
  c_PQresultStatus :: Ptr PGresult -> IO ExecStatusType

foreign import ccall unsafe "PQresultErrorField"
  c_PQresultErrorField :: Ptr PGresult -> ErrorField -> IO CString

foreign import ccall unsafe "PQresultErrorMessage"
  c_PQresultErrorMessage :: Ptr PGresult -> IO CString

foreign import ccall unsafe "PQntuples"
  c_PQntuples :: Ptr PGresult -> IO CInt

foreign import ccall unsafe "PQnfields"
  c_PQnfields :: Ptr PGresult -> IO CInt

foreign import ccall unsafe "PQcmdTuples"
  c_PQcmdTuples :: Ptr PGresult -> IO CString

foreign import ccall unsafe "PQgetisnull"
  c_PQgetisnull :: Ptr PGresult -> CInt -> CInt -> IO CInt

foreign import ccall unsafe "PQfname"
  c_PQfname :: Ptr PGresult -> CInt -> IO CString

-- | Safe as it performs multiple actions when clearing the result.
foreign import ccall safe "PQclear"
  c_PQclear :: Ptr PGresult -> IO ()

-- | Safe as it performs multiple actions when clearing the result.
foreign import ccall safe "&PQclear"
  c_ptr_PQclear :: FunPtr (Ptr PGresult -> IO ())

----------------------------------------
-- PGcancel

foreign import ccall unsafe "PQgetCancel"
  c_PQgetCancel :: Ptr PGconn -> IO (Ptr PGcancel)

foreign import ccall unsafe "PQfreeCancel"
  c_PQfreeCancel :: Ptr PGcancel -> IO ()

-- | Safe as it establishes a separate connection to PostgreSQL to send the
-- cancellation request.
foreign import ccall safe "PQcancel"
  c_rawPQcancel :: Ptr PGcancel -> CString -> CInt -> IO CInt

-- | Attempt to cancel currently running query. If the request is successfully
-- dispatched Nothing is returned, otherwise a textual explanation of what
-- happened.
c_PQcancel :: Ptr PGconn -> IO (Maybe String)
c_PQcancel :: Ptr PGconn -> IO (Maybe String)
c_PQcancel Ptr PGconn
conn = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Ptr PGconn -> IO (Ptr PGcancel)
c_PQgetCancel Ptr PGconn
conn) Ptr PGcancel -> IO ()
c_PQfreeCancel forall a b. (a -> b) -> a -> b
$ \Ptr PGcancel
cancel -> do
  forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
errbufsize forall a b. (a -> b) -> a -> b
$ \Ptr CChar
errbuf -> do
    Ptr PGcancel -> Ptr CChar -> CInt -> IO CInt
c_rawPQcancel Ptr PGcancel
cancel Ptr CChar
errbuf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
errbufsize) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CInt
0 -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO String
peekCString Ptr CChar
errbuf
      CInt
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  where
    -- Size recommended by
    -- https://www.postgresql.org/docs/current/static/libpq-cancel.html
    errbufsize :: Int
    errbufsize :: Int
errbufsize = Int
256

----------------------------------------
-- libpqtypes / PGparam

foreign import ccall unsafe "PQparamCreate"
  c_PQparamCreate :: Ptr PGconn -> Ptr PGerror -> IO (Ptr PGparam)

foreign import ccall unsafe "PQparamClear"
  c_PQparamClear :: Ptr PGparam -> IO ()

foreign import ccall unsafe "PQparamCount"
  c_PQparamCount :: Ptr PGparam -> IO CInt

-- | Safe as it calls PQregisterEventProc with a nontrivial callback.
foreign import ccall safe "PQinitTypes"
  c_PQinitTypes :: Ptr PGconn -> IO ()

-- | Safe as it sends a query to the server.
foreign import ccall safe "PQregisterTypes"
  c_PQregisterTypes :: Ptr PGconn -> Ptr PGerror -> TypeClass -> Ptr PGregisterType -> CInt -> CInt -> IO CInt

-- | Safe as query execution might run for a long time.
foreign import ccall safe "PQparamExec"
  c_rawPQparamExec :: Ptr PGconn -> Ptr PGerror -> Ptr PGparam -> CString -> ResultFormat -> IO (Ptr PGresult)

-- | Safe as it contacts the server.
foreign import ccall safe "PQparamPrepare"
  c_rawPQparamPrepare :: Ptr PGconn -> Ptr PGerror -> Ptr PGparam -> CString -> CString -> IO (Ptr PGresult)

-- | Safe as query execution might run for a long time.
foreign import ccall safe "PQparamExecPrepared"
  c_rawPQparamExecPrepared :: Ptr PGconn -> Ptr PGerror -> Ptr PGparam -> CString -> ResultFormat -> IO (Ptr PGresult)

-- | Safe wrapper for 'c_rawPQparamExec'. Wraps result returned by
-- 'c_rawPQparamExec' in 'ForeignPtr' with asynchronous exceptions masked to
-- prevent memory leaks.
c_PQparamExec :: Ptr PGconn -> Ptr PGerror -> Ptr PGparam -> CString -> ResultFormat -> IO (ForeignPtr PGresult)
c_PQparamExec :: Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> Ptr CChar
-> ResultFormat
-> IO (ForeignPtr PGresult)
c_PQparamExec Ptr PGconn
conn Ptr PGerror
err Ptr PGparam
param Ptr CChar
fmt ResultFormat
mode = do
  forall a. IO a -> IO a
E.mask_ forall a b. (a -> b) -> a -> b
$ forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr PGresult -> IO ())
c_ptr_PQclear
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> Ptr CChar
-> ResultFormat
-> IO (Ptr PGresult)
c_rawPQparamExec Ptr PGconn
conn Ptr PGerror
err Ptr PGparam
param Ptr CChar
fmt ResultFormat
mode

-- | Safe wrapper for 'c_rawPQprepare'. Wraps result returned by
-- 'c_rawPQprepare' in 'ForeignPtr' with asynchronous exceptions masked to
-- prevent memory leaks.
c_PQparamPrepare
  :: Ptr PGconn
  -> Ptr PGerror
  -> Ptr PGparam
  -> CString
  -> CString
  -> IO (ForeignPtr PGresult)
c_PQparamPrepare :: Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> Ptr CChar
-> Ptr CChar
-> IO (ForeignPtr PGresult)
c_PQparamPrepare Ptr PGconn
conn Ptr PGerror
err Ptr PGparam
param Ptr CChar
queryName Ptr CChar
query = do
  forall a. IO a -> IO a
E.mask_ forall a b. (a -> b) -> a -> b
$ forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr PGresult -> IO ())
c_ptr_PQclear
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> Ptr CChar
-> Ptr CChar
-> IO (Ptr PGresult)
c_rawPQparamPrepare Ptr PGconn
conn Ptr PGerror
err Ptr PGparam
param Ptr CChar
queryName Ptr CChar
query

-- | Safe wrapper for 'c_rawPQparamExecPrepared'. Wraps result returned by
-- 'c_rawPQparamExecPrepared' in 'ForeignPtr' with asynchronous exceptions
-- masked to prevent memory leaks.
c_PQparamExecPrepared
  :: Ptr PGconn
  -> Ptr PGerror
  -> Ptr PGparam
  -> CString
  -> ResultFormat
  -> IO (ForeignPtr PGresult)
c_PQparamExecPrepared :: Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> Ptr CChar
-> ResultFormat
-> IO (ForeignPtr PGresult)
c_PQparamExecPrepared Ptr PGconn
conn Ptr PGerror
err Ptr PGparam
param Ptr CChar
queryName ResultFormat
mode = do
  forall a. IO a -> IO a
E.mask_ forall a b. (a -> b) -> a -> b
$ forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr PGresult -> IO ())
c_ptr_PQclear
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PGconn
-> Ptr PGerror
-> Ptr PGparam
-> Ptr CChar
-> ResultFormat
-> IO (Ptr PGresult)
c_rawPQparamExecPrepared Ptr PGconn
conn Ptr PGerror
err Ptr PGparam
param Ptr CChar
queryName ResultFormat
mode

----------------------------------------
-- Miscellaneous

foreign import ccall unsafe "&pqt_hs_null_string_ptr"
  nullStringPtr :: Ptr CChar

nullStringCStringLen :: CStringLen
nullStringCStringLen :: CStringLen
nullStringCStringLen = (Ptr CChar
nullStringPtr, Int
0)