-- | The native (pure-Haskell) @pqi@ adapter.
--
-- 'adapter' bundles the three functions that produce a 'Pqi.Connection'
-- whose fields are closures over the underlying native 'Connection.Connection'
-- (which speaks the PostgreSQL wire protocol directly). 'Pqi.Result' and
-- 'Pqi.Cancel' values are constructed the same way, in "Pqi.Native.Types".
module Pqi.Native
  ( adapter,
  )
where

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as ByteString.Char8
import qualified Data.Map.Strict as Map
import qualified Pqi
import Pqi.Native.Connection (Connection)
import qualified Pqi.Native.Connection as Connection
import qualified Pqi.Native.LargeObject as LargeObject
import Pqi.Native.Prelude
import qualified Pqi.Native.Query as Query
import qualified Pqi.Native.Transport as Transport
import Pqi.Native.Transport.Message
  ( BackendMessage (..),
    copyDataMessage,
    copyDoneMessage,
    copyFailMessage,
    flushMessage,
    syncMessage,
  )
import Pqi.Native.Types (NativeCancel (..), NativeResult (..), mkCancel, mkResult)
import qualified Pqi.Native.UnescapeBytea as UnescapeBytea
import System.Posix.Types (Fd)

-- | The native adapter.
adapter :: Pqi.Adapter
adapter :: Adapter
adapter =
  Pqi.Adapter
    { name :: Text
Pqi.name = Text
"pqi-native",
      connectdb :: ByteString -> IO Connection
Pqi.connectdb = \ByteString
conninfo -> Connection -> Connection
mkConnection (Connection -> Connection) -> IO Connection -> IO Connection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Connection
Connection.establish ByteString
conninfo,
      connectStart :: ByteString -> IO Connection
Pqi.connectStart = \ByteString
conninfo -> Connection -> Connection
mkConnection (Connection -> Connection) -> IO Connection -> IO Connection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO Connection
Connection.establish ByteString
conninfo,
      newNullConnection :: IO Connection
Pqi.newNullConnection = Connection -> Connection
mkConnection (Connection -> Connection) -> IO Connection -> IO Connection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Connection
Connection.nullConnection,
      unescapeBytea :: ByteString -> IO (Maybe ByteString)
Pqi.unescapeBytea = \ByteString
input -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> ByteString
UnescapeBytea.unescapeBytea ByteString
input)),
      resStatus :: ExecStatus -> IO ByteString
Pqi.resStatus = ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString)
-> (ExecStatus -> ByteString) -> ExecStatus -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecStatus -> ByteString
resStatus
    }

-- | The string libpq's @PQresStatus@ describes each status code with.
resStatus :: Pqi.ExecStatus -> ByteString
resStatus :: ExecStatus -> ByteString
resStatus = \case
  ExecStatus
Pqi.EmptyQuery -> ByteString
"PGRES_EMPTY_QUERY"
  ExecStatus
Pqi.CommandOk -> ByteString
"PGRES_COMMAND_OK"
  ExecStatus
Pqi.TuplesOk -> ByteString
"PGRES_TUPLES_OK"
  ExecStatus
Pqi.CopyOut -> ByteString
"PGRES_COPY_OUT"
  ExecStatus
Pqi.CopyIn -> ByteString
"PGRES_COPY_IN"
  ExecStatus
Pqi.CopyBoth -> ByteString
"PGRES_COPY_BOTH"
  ExecStatus
Pqi.BadResponse -> ByteString
"PGRES_BAD_RESPONSE"
  ExecStatus
Pqi.NonfatalError -> ByteString
"PGRES_NONFATAL_ERROR"
  ExecStatus
Pqi.FatalError -> ByteString
"PGRES_FATAL_ERROR"
  ExecStatus
Pqi.SingleTuple -> ByteString
"PGRES_SINGLE_TUPLE"
  ExecStatus
Pqi.PipelineSync -> ByteString
"PGRES_PIPELINE_SYNC"
  ExecStatus
Pqi.PipelineAbort -> ByteString
"PGRES_PIPELINE_ABORTED"

-- | Build a 'Pqi.Connection' whose fields close over the given native
-- connection.
mkConnection :: Connection -> Pqi.Connection
mkConnection :: Connection -> Connection
mkConnection Connection
connection =
  Pqi.Connection
    { connectPoll :: IO PollingStatus
Pqi.connectPoll = PollingStatus -> IO PollingStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PollingStatus
Pqi.PollingOk,
      isNullConnection :: Bool
Pqi.isNullConnection = (Connection -> Bool
Connection.isNull Connection
connection),
      finish :: IO ()
Pqi.finish = do
        Transport
transport <- IORef Transport -> IO Transport
forall a. IORef a -> IO a
readIORef (Connection -> IORef Transport
Connection.transport Connection
connection)
        Transport -> IO ()
Transport.close Transport
transport
        -- Mark the connection unusable so that any further protocol
        -- operation is rejected by the 'ConnectionOk' guards (e.g.
        -- 'Pqi.Native.Query.sendAsync', 'withReady') instead of attempting
        -- I/O on the now-closed socket. Without this, a caller that keeps
        -- using a 'Pqi.Connection' after 'finish' (a supported pattern via
        -- 'Hasql.Session.onLibpqConnection', used e.g. by hasql-pool to test
        -- eviction of a broken connection) can have a later send attempt
        -- block forever instead of failing, if the closed file descriptor
        -- has since been reused elsewhere in the process.
        IORef ConnStatus -> ConnStatus -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef ConnStatus
Connection.connStatus Connection
connection) ConnStatus
Pqi.ConnectionBad,
      reset :: IO ()
Pqi.reset = Connection -> IO ()
Connection.reconnect Connection
connection,
      resetStart :: IO Bool
Pqi.resetStart = Connection -> IO ()
Connection.reconnect Connection
connection IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True,
      resetPoll :: IO PollingStatus
Pqi.resetPoll = PollingStatus -> IO PollingStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PollingStatus
Pqi.PollingOk,
      db :: IO (Maybe ByteString)
Pqi.db = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ConnInfo -> ByteString
Connection.database (Connection -> ConnInfo
Connection.info Connection
connection))),
      user :: IO (Maybe ByteString)
Pqi.user = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ConnInfo -> ByteString
Connection.user (Connection -> ConnInfo
Connection.info Connection
connection))),
      pass :: IO (Maybe ByteString)
Pqi.pass = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ConnInfo -> ByteString
Connection.password (Connection -> ConnInfo
Connection.info Connection
connection))),
      host :: IO (Maybe ByteString)
Pqi.host = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ConnInfo -> ByteString
Connection.host (Connection -> ConnInfo
Connection.info Connection
connection))),
      port :: IO (Maybe ByteString)
Pqi.port = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (FilePath -> ByteString
ByteString.Char8.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (ConnInfo -> Int
Connection.port (Connection -> ConnInfo
Connection.info Connection
connection))))),
      options :: IO (Maybe ByteString)
Pqi.options = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
""),
      status :: IO ConnStatus
Pqi.status = IORef ConnStatus -> IO ConnStatus
forall a. IORef a -> IO a
readIORef (Connection -> IORef ConnStatus
Connection.connStatus Connection
connection),
      transactionStatus :: IO TransactionStatus
Pqi.transactionStatus = Word8 -> TransactionStatus
transactionStatusOf (Word8 -> TransactionStatus) -> IO Word8 -> IO TransactionStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Word8 -> IO Word8
forall a. IORef a -> IO a
readIORef (Connection -> IORef Word8
Connection.txStatus Connection
connection),
      parameterStatus :: ByteString -> IO (Maybe ByteString)
Pqi.parameterStatus = \ByteString
name -> ByteString -> Map ByteString ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
name (Map ByteString ByteString -> Maybe ByteString)
-> IO (Map ByteString ByteString) -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map ByteString ByteString) -> IO (Map ByteString ByteString)
forall a. IORef a -> IO a
readIORef (Connection -> IORef (Map ByteString ByteString)
Connection.parameters Connection
connection),
      protocolVersion :: IO Int
Pqi.protocolVersion = Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
3,
      serverVersion :: IO Int
Pqi.serverVersion =
        Int -> (ByteString -> Int) -> Maybe ByteString -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ByteString -> Int
parseServerVersion (Maybe ByteString -> Int)
-> (Map ByteString ByteString -> Maybe ByteString)
-> Map ByteString ByteString
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Map ByteString ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"server_version" (Map ByteString ByteString -> Int)
-> IO (Map ByteString ByteString) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map ByteString ByteString) -> IO (Map ByteString ByteString)
forall a. IORef a -> IO a
readIORef (Connection -> IORef (Map ByteString ByteString)
Connection.parameters Connection
connection),
      errorMessage :: IO (Maybe ByteString)
Pqi.errorMessage = IORef (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IORef a -> IO a
readIORef (Connection -> IORef (Maybe ByteString)
Connection.lastError Connection
connection),
      socket :: IO (Maybe Fd)
Pqi.socket = do
        Transport
transport <- IORef Transport -> IO Transport
forall a. IORef a -> IO a
readIORef (Connection -> IORef Transport
Connection.transport Connection
connection)
        Int32
fd <- Transport -> IO Int32
Transport.socketFd Transport
transport
        Maybe Fd -> IO (Maybe Fd)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fd -> Maybe Fd
forall a. a -> Maybe a
Just (Int32 -> Fd
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
fd :: Fd)),
      backendPID :: IO Int32
Pqi.backendPID = Int32 -> ((Int32, Int32) -> Int32) -> Maybe (Int32, Int32) -> Int32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int32
0 (Int32, Int32) -> Int32
forall a b. (a, b) -> a
fst (Maybe (Int32, Int32) -> Int32)
-> IO (Maybe (Int32, Int32)) -> IO Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Maybe (Int32, Int32)) -> IO (Maybe (Int32, Int32))
forall a. IORef a -> IO a
readIORef (Connection -> IORef (Maybe (Int32, Int32))
Connection.backendKey Connection
connection),
      connectionNeedsPassword :: IO Bool
Pqi.connectionNeedsPassword = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False,
      connectionUsedPassword :: IO Bool
Pqi.connectionUsedPassword = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Bool
not (ByteString -> Bool
ByteString.null (ConnInfo -> ByteString
Connection.password (Connection -> ConnInfo
Connection.info Connection
connection)))),
      exec :: ByteString -> IO (Maybe Result)
Pqi.exec = \ByteString
sql -> (NativeResult -> Result) -> Maybe NativeResult -> Maybe Result
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NativeResult -> Result
mkResult (Maybe NativeResult -> Maybe Result)
-> IO (Maybe NativeResult) -> IO (Maybe Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Maybe NativeResult)
Query.exec Connection
connection ByteString
sql,
      execParams :: ByteString
-> [Maybe (Word32, ByteString, Format)]
-> Format
-> IO (Maybe Result)
Pqi.execParams = \ByteString
sql [Maybe (Word32, ByteString, Format)]
params Format
resultFormat ->
        (NativeResult -> Result) -> Maybe NativeResult -> Maybe Result
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NativeResult -> Result
mkResult (Maybe NativeResult -> Maybe Result)
-> IO (Maybe NativeResult) -> IO (Maybe Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> Format
-> IO (Maybe NativeResult)
Query.execParams Connection
connection ByteString
sql [Maybe (Word32, ByteString, Format)]
params Format
resultFormat,
      prepare :: ByteString -> ByteString -> Maybe [Word32] -> IO (Maybe Result)
Pqi.prepare = \ByteString
name ByteString
sql Maybe [Word32]
parameterTypes ->
        (NativeResult -> Result) -> Maybe NativeResult -> Maybe Result
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NativeResult -> Result
mkResult (Maybe NativeResult -> Maybe Result)
-> IO (Maybe NativeResult) -> IO (Maybe Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> ByteString
-> Maybe [Word32]
-> IO (Maybe NativeResult)
Query.prepare Connection
connection ByteString
name ByteString
sql Maybe [Word32]
parameterTypes,
      execPrepared :: ByteString
-> [Maybe (ByteString, Format)] -> Format -> IO (Maybe Result)
Pqi.execPrepared = \ByteString
name [Maybe (ByteString, Format)]
params Format
resultFormat ->
        (NativeResult -> Result) -> Maybe NativeResult -> Maybe Result
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NativeResult -> Result
mkResult (Maybe NativeResult -> Maybe Result)
-> IO (Maybe NativeResult) -> IO (Maybe Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (ByteString, Format)]
-> Format
-> IO (Maybe NativeResult)
Query.execPrepared Connection
connection ByteString
name [Maybe (ByteString, Format)]
params Format
resultFormat,
      describePrepared :: ByteString -> IO (Maybe Result)
Pqi.describePrepared = \ByteString
name -> (NativeResult -> Result) -> Maybe NativeResult -> Maybe Result
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NativeResult -> Result
mkResult (Maybe NativeResult -> Maybe Result)
-> IO (Maybe NativeResult) -> IO (Maybe Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Maybe NativeResult)
Query.describePrepared Connection
connection ByteString
name,
      describePortal :: ByteString -> IO (Maybe Result)
Pqi.describePortal = \ByteString
name -> (NativeResult -> Result) -> Maybe NativeResult -> Maybe Result
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NativeResult -> Result
mkResult (Maybe NativeResult -> Maybe Result)
-> IO (Maybe NativeResult) -> IO (Maybe Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Maybe NativeResult)
Query.describePortal Connection
connection ByteString
name,
      escapeStringConn :: ByteString -> IO (Maybe ByteString)
Pqi.escapeStringConn = \ByteString
value ->
        if ByteString -> Bool
isValidUtf8 ByteString
value
          then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
"''" (Word8 -> ByteString -> [ByteString]
ByteString.split Word8
0x27 ByteString
value)))
          else Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing,
      escapeByteaConn :: ByteString -> IO (Maybe ByteString)
Pqi.escapeByteaConn = \ByteString
value -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString
"\\x" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
hexEncode ByteString
value)),
      escapeIdentifier :: ByteString -> IO (Maybe ByteString)
Pqi.escapeIdentifier = \ByteString
value ->
        if ByteString -> Bool
isValidUtf8 ByteString
value
          then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString
"\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
"\"\"" (Word8 -> ByteString -> [ByteString]
ByteString.split Word8
0x22 ByteString
value) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""))
          else Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing,
      sendQuery :: ByteString -> IO Bool
Pqi.sendQuery = Connection -> ByteString -> IO Bool
Query.sendQuery Connection
connection,
      sendQueryParams :: ByteString
-> [Maybe (Word32, ByteString, Format)] -> Format -> IO Bool
Pqi.sendQueryParams = \ByteString
sql [Maybe (Word32, ByteString, Format)]
params Format
resultFormat -> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> Format
-> IO Bool
Query.sendQueryParams Connection
connection ByteString
sql [Maybe (Word32, ByteString, Format)]
params Format
resultFormat,
      sendPrepare :: ByteString -> ByteString -> Maybe [Word32] -> IO Bool
Pqi.sendPrepare = \ByteString
name ByteString
sql Maybe [Word32]
parameterTypes -> Connection -> ByteString -> ByteString -> Maybe [Word32] -> IO Bool
Query.sendPrepare Connection
connection ByteString
name ByteString
sql Maybe [Word32]
parameterTypes,
      sendQueryPrepared :: ByteString -> [Maybe (ByteString, Format)] -> Format -> IO Bool
Pqi.sendQueryPrepared = \ByteString
name [Maybe (ByteString, Format)]
params Format
resultFormat -> Connection
-> ByteString -> [Maybe (ByteString, Format)] -> Format -> IO Bool
Query.sendQueryPrepared Connection
connection ByteString
name [Maybe (ByteString, Format)]
params Format
resultFormat,
      sendDescribePrepared :: ByteString -> IO Bool
Pqi.sendDescribePrepared = Connection -> ByteString -> IO Bool
Query.sendDescribePrepared Connection
connection,
      sendDescribePortal :: ByteString -> IO Bool
Pqi.sendDescribePortal = Connection -> ByteString -> IO Bool
Query.sendDescribePortal Connection
connection,
      getResult :: IO (Maybe Result)
Pqi.getResult = (NativeResult -> Result) -> Maybe NativeResult -> Maybe Result
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NativeResult -> Result
mkResult (Maybe NativeResult -> Maybe Result)
-> IO (Maybe NativeResult) -> IO (Maybe Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe NativeResult)
Query.getNextResult Connection
connection,
      consumeInput :: IO Bool
Pqi.consumeInput = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True,
      isBusy :: IO Bool
Pqi.isBusy = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False,
      setnonblocking :: Bool -> IO Bool
Pqi.setnonblocking = \Bool
flag -> IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Bool
Connection.nonblocking Connection
connection) Bool
flag IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True,
      isnonblocking :: IO Bool
Pqi.isnonblocking = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (Connection -> IORef Bool
Connection.nonblocking Connection
connection),
      setSingleRowMode :: IO Bool
Pqi.setSingleRowMode = do
        Bool
pending <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (Connection -> IORef Bool
Connection.asyncPending Connection
connection)
        if Bool
pending
          then IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Bool
Connection.singleRowMode Connection
connection) Bool
True IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
          else Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False,
      flush :: IO FlushStatus
Pqi.flush = FlushStatus -> IO FlushStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlushStatus
Pqi.FlushOk,
      pipelineStatus :: IO PipelineStatus
Pqi.pipelineStatus = IORef PipelineStatus -> IO PipelineStatus
forall a. IORef a -> IO a
readIORef (Connection -> IORef PipelineStatus
Connection.pipelineStatus Connection
connection),
      enterPipelineMode :: IO Bool
Pqi.enterPipelineMode = IORef PipelineStatus -> PipelineStatus -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef PipelineStatus
Connection.pipelineStatus Connection
connection) PipelineStatus
Pqi.PipelineOn IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True,
      exitPipelineMode :: IO Bool
Pqi.exitPipelineMode = do
        Bool
pending <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (Connection -> IORef Bool
Connection.asyncPending Connection
connection)
        if Bool
pending
          then Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          else IORef PipelineStatus -> PipelineStatus -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef PipelineStatus
Connection.pipelineStatus Connection
connection) PipelineStatus
Pqi.PipelineOff IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True,
      pipelineSync :: IO Bool
Pqi.pipelineSync = do
        Connection -> Write -> IO ()
Connection.sendMessage Connection
connection Write
syncMessage
        IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Connection -> IORef Int
Connection.pendingSyncs Connection
connection) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Bool
Connection.asyncPending Connection
connection) Bool
True
        Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True,
      sendFlushRequest :: IO Bool
Pqi.sendFlushRequest = Connection -> Write -> IO ()
Connection.sendMessage Connection
connection Write
flushMessage IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True,
      getCancel :: IO (Maybe Cancel)
Pqi.getCancel = do
        Maybe (Int32, Int32)
key <- IORef (Maybe (Int32, Int32)) -> IO (Maybe (Int32, Int32))
forall a. IORef a -> IO a
readIORef (Connection -> IORef (Maybe (Int32, Int32))
Connection.backendKey Connection
connection)
        Maybe Cancel -> IO (Maybe Cancel)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Maybe Cancel -> IO (Maybe Cancel))
-> Maybe Cancel -> IO (Maybe Cancel)
forall a b. (a -> b) -> a -> b
$ ((Int32, Int32) -> Cancel) -> Maybe (Int32, Int32) -> Maybe Cancel
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \(Int32
pid, Int32
secret) ->
                NativeCancel -> Cancel
mkCancel
                  NativeCancel
                    { host :: ByteString
host = ConnInfo -> ByteString
Connection.host (Connection -> ConnInfo
Connection.info Connection
connection),
                      port :: Int
port = ConnInfo -> Int
Connection.port (Connection -> ConnInfo
Connection.info Connection
connection),
                      Int32
pid :: Int32
pid :: Int32
pid,
                      Int32
secret :: Int32
secret :: Int32
secret,
                      asyncPendingRef :: IORef Bool
asyncPendingRef = (Connection -> IORef Bool
Connection.asyncPending Connection
connection),
                      pipelineStatusRef :: IORef PipelineStatus
pipelineStatusRef = (Connection -> IORef PipelineStatus
Connection.pipelineStatus Connection
connection),
                      pendingCommandsRef :: IORef Int
pendingCommandsRef = (Connection -> IORef Int
Connection.pendingCommands Connection
connection)
                    }
            )
            Maybe (Int32, Int32)
key,
      notifies :: IO (Maybe Notify)
Pqi.notifies = IORef [Notify] -> IO (Maybe Notify)
forall a. IORef [a] -> IO (Maybe a)
popFirst (Connection -> IORef [Notify]
Connection.pendingNotifications Connection
connection),
      disableNoticeReporting :: IO ()
Pqi.disableNoticeReporting = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Bool
Connection.noticeReporting Connection
connection) Bool
False,
      enableNoticeReporting :: IO ()
Pqi.enableNoticeReporting = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Bool
Connection.noticeReporting Connection
connection) Bool
True,
      getNotice :: IO (Maybe ByteString)
Pqi.getNotice = IORef [ByteString] -> IO (Maybe ByteString)
forall a. IORef [a] -> IO (Maybe a)
popFirst (Connection -> IORef [ByteString]
Connection.notices Connection
connection),
      putCopyData :: ByteString -> IO CopyInResult
Pqi.putCopyData = \ByteString
payload -> Connection -> Write -> IO ()
Connection.sendMessage Connection
connection (ByteString -> Write
copyDataMessage ByteString
payload) IO () -> CopyInResult -> IO CopyInResult
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CopyInResult
Pqi.CopyInOk,
      putCopyEnd :: Maybe ByteString -> IO CopyInResult
Pqi.putCopyEnd = \Maybe ByteString
reason -> do
        Connection -> Write -> IO ()
Connection.sendMessage Connection
connection (Write -> (ByteString -> Write) -> Maybe ByteString -> Write
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Write
copyDoneMessage ByteString -> Write
copyFailMessage Maybe ByteString
reason)
        IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Bool
Connection.asyncPending Connection
connection) Bool
True
        CopyInResult -> IO CopyInResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CopyInResult
Pqi.CopyInOk,
      getCopyData :: Bool -> IO CopyOutResult
Pqi.getCopyData = Connection -> Bool -> IO CopyOutResult
getCopyData Connection
connection,
      loCreat :: IO (Maybe Word32)
Pqi.loCreat = Connection -> IO (Maybe Word32)
LargeObject.loCreat Connection
connection,
      loCreate :: Word32 -> IO (Maybe Word32)
Pqi.loCreate = Connection -> Word32 -> IO (Maybe Word32)
LargeObject.loCreate Connection
connection,
      loImport :: FilePath -> IO (Maybe Word32)
Pqi.loImport = Connection -> FilePath -> IO (Maybe Word32)
LargeObject.loImport Connection
connection,
      loImportWithOid :: FilePath -> Word32 -> IO (Maybe Word32)
Pqi.loImportWithOid = Connection -> FilePath -> Word32 -> IO (Maybe Word32)
LargeObject.loImportWithOid Connection
connection,
      loExport :: Word32 -> FilePath -> IO (Maybe ())
Pqi.loExport = Connection -> Word32 -> FilePath -> IO (Maybe ())
LargeObject.loExport Connection
connection,
      loOpen :: Word32 -> IOMode -> IO (Maybe Int32)
Pqi.loOpen = Connection -> Word32 -> IOMode -> IO (Maybe Int32)
LargeObject.loOpen Connection
connection,
      loWrite :: Int32 -> ByteString -> IO (Maybe Int)
Pqi.loWrite = Connection -> Int32 -> ByteString -> IO (Maybe Int)
LargeObject.loWrite Connection
connection,
      loRead :: Int32 -> Int -> IO (Maybe ByteString)
Pqi.loRead = Connection -> Int32 -> Int -> IO (Maybe ByteString)
LargeObject.loRead Connection
connection,
      loSeek :: Int32 -> SeekMode -> Int -> IO (Maybe Int)
Pqi.loSeek = Connection -> Int32 -> SeekMode -> Int -> IO (Maybe Int)
LargeObject.loSeek Connection
connection,
      loTell :: Int32 -> IO (Maybe Int)
Pqi.loTell = Connection -> Int32 -> IO (Maybe Int)
LargeObject.loTell Connection
connection,
      loTruncate :: Int32 -> Int -> IO (Maybe ())
Pqi.loTruncate = Connection -> Int32 -> Int -> IO (Maybe ())
LargeObject.loTruncate Connection
connection,
      loClose :: Int32 -> IO (Maybe ())
Pqi.loClose = Connection -> Int32 -> IO (Maybe ())
LargeObject.loClose Connection
connection,
      loUnlink :: Word32 -> IO (Maybe ())
Pqi.loUnlink = Connection -> Word32 -> IO (Maybe ())
LargeObject.loUnlink Connection
connection,
      clientEncoding :: IO ByteString
Pqi.clientEncoding =
        ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"SQL_ASCII" (Maybe ByteString -> ByteString)
-> (Map ByteString ByteString -> Maybe ByteString)
-> Map ByteString ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Map ByteString ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
"client_encoding" (Map ByteString ByteString -> ByteString)
-> IO (Map ByteString ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map ByteString ByteString) -> IO (Map ByteString ByteString)
forall a. IORef a -> IO a
readIORef (Connection -> IORef (Map ByteString ByteString)
Connection.parameters Connection
connection),
      setClientEncoding :: ByteString -> IO Bool
Pqi.setClientEncoding = \ByteString
encoding -> do
        Maybe NativeResult
result <- Connection -> ByteString -> IO (Maybe NativeResult)
Query.exec Connection
connection (ByteString
"SET client_encoding TO '" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
encoding ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"'")
        Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> (NativeResult -> Bool) -> Maybe NativeResult -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\NativeResult
value -> NativeResult -> ExecStatus
status NativeResult
value ExecStatus -> ExecStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= ExecStatus
Pqi.FatalError) Maybe NativeResult
result),
      setErrorVerbosity :: Verbosity -> IO Verbosity
Pqi.setErrorVerbosity = \Verbosity
verbosity -> do
        Verbosity
previous <- IORef Verbosity -> IO Verbosity
forall a. IORef a -> IO a
readIORef (Connection -> IORef Verbosity
Connection.errorVerbosity Connection
connection)
        IORef Verbosity -> Verbosity -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Verbosity
Connection.errorVerbosity Connection
connection) Verbosity
verbosity
        Verbosity -> IO Verbosity
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
previous
    }

-- | Receive data on a @COPY TO STDOUT@ connection, as 'Pqi.getCopyData'. The
-- native adapter has no non-blocking transport, so the @Bool@ argument is
-- ignored; it always reads until a full chunk (or the end of the copy) is
-- available.
getCopyData :: Connection -> Bool -> IO Pqi.CopyOutResult
getCopyData :: Connection -> Bool -> IO CopyOutResult
getCopyData Connection
connection Bool
nonBlocking = do
  BackendMessage
message <- Connection -> IO BackendMessage
Connection.nextMessage Connection
connection
  case BackendMessage
message of
    CopyData ByteString
payload -> CopyOutResult -> IO CopyOutResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> CopyOutResult
Pqi.CopyOutRow ByteString
payload)
    BackendMessage
CopyDone -> do
      IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Bool
Connection.asyncPending Connection
connection) Bool
True
      CopyOutResult -> IO CopyOutResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CopyOutResult
Pqi.CopyOutDone
    CommandComplete ByteString
_ -> Connection -> IO ()
drainToReady Connection
connection IO () -> CopyOutResult -> IO CopyOutResult
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CopyOutResult
Pqi.CopyOutDone
    ErrorResponse [(Word8, ByteString)]
_ -> Connection -> IO ()
drainToReady Connection
connection IO () -> CopyOutResult -> IO CopyOutResult
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CopyOutResult
Pqi.CopyOutError
    ReadyForQuery Word8
txState -> IORef Word8 -> Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Word8
Connection.txStatus Connection
connection) Word8
txState IO () -> CopyOutResult -> IO CopyOutResult
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CopyOutResult
Pqi.CopyOutDone
    BackendMessage
_ -> Connection -> Bool -> IO CopyOutResult
getCopyData Connection
connection Bool
nonBlocking

-- | Read messages until @ReadyForQuery@, recording the transaction status.
drainToReady :: Connection -> IO ()
drainToReady :: Connection -> IO ()
drainToReady Connection
connection = do
  BackendMessage
message <- Connection -> IO BackendMessage
Connection.nextMessage Connection
connection
  case BackendMessage
message of
    ReadyForQuery Word8
txState -> IORef Word8 -> Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Connection -> IORef Word8
Connection.txStatus Connection
connection) Word8
txState
    BackendMessage
_ -> Connection -> IO ()
drainToReady Connection
connection

-- | Pop the oldest element of a list stored newest-first.
popFirst :: IORef [a] -> IO (Maybe a)
popFirst :: forall a. IORef [a] -> IO (Maybe a)
popFirst IORef [a]
ref =
  IORef [a] -> ([a] -> ([a], Maybe a)) -> IO (Maybe a)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [a]
ref \[a]
xs -> case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs of
    [] -> ([], Maybe a
forall a. Maybe a
Nothing)
    a
oldest : [a]
rest -> ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rest, a -> Maybe a
forall a. a -> Maybe a
Just a
oldest)

transactionStatusOf :: Word8 -> Pqi.TransactionStatus
transactionStatusOf :: Word8 -> TransactionStatus
transactionStatusOf = \case
  Word8
0x49 -> TransactionStatus
Pqi.TransIdle -- 'I'
  Word8
0x54 -> TransactionStatus
Pqi.TransInTrans -- 'T'
  Word8
0x45 -> TransactionStatus
Pqi.TransInError -- 'E'
  Word8
_ -> TransactionStatus
Pqi.TransUnknown

-- | Parse the @server_version@ parameter into libpq's @MMmmpp@ integer form
-- (e.g. @\"17.2\"@ -> @170002@, @\"9.6.3\"@ -> @90603@).
parseServerVersion :: ByteString -> Int
parseServerVersion :: ByteString -> Int
parseServerVersion ByteString
raw =
  case ByteString -> Maybe (Int, ByteString)
ByteString.Char8.readInt ByteString
raw of
    Maybe (Int, ByteString)
Nothing -> Int
0
    Just (Int
major, ByteString
rest)
      | Int
major Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10 -> Int
major Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
nextInt ByteString
rest
      | Bool
otherwise ->
          let minor :: Int
minor = ByteString -> Int
nextInt ByteString
rest
              patch :: Int
patch = ByteString -> Int
nextInt (ByteString -> ByteString
dropInt ByteString
rest)
           in Int
major Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
patch
  where
    nextInt :: ByteString -> Int
nextInt ByteString
bs = case ByteString -> Maybe (Char, ByteString)
ByteString.Char8.uncons ByteString
bs of
      Just (Char
'.', ByteString
remainder) -> Int -> ((Int, ByteString) -> Int) -> Maybe (Int, ByteString) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst (ByteString -> Maybe (Int, ByteString)
ByteString.Char8.readInt ByteString
remainder)
      Maybe (Char, ByteString)
_ -> Int
0
    dropInt :: ByteString -> ByteString
dropInt ByteString
bs = case ByteString -> Maybe (Char, ByteString)
ByteString.Char8.uncons ByteString
bs of
      Just (Char
'.', ByteString
remainder) -> case ByteString -> Maybe (Int, ByteString)
ByteString.Char8.readInt ByteString
remainder of
        Just (Int
_, ByteString
leftover) -> ByteString
leftover
        Maybe (Int, ByteString)
Nothing -> ByteString
remainder
      Maybe (Char, ByteString)
_ -> ByteString
bs

isValidUtf8 :: ByteString -> Bool
isValidUtf8 :: ByteString -> Bool
isValidUtf8 = [Word8] -> Bool
forall {a}. (Ord a, Num a, Bits a) => [a] -> Bool
go ([Word8] -> Bool) -> (ByteString -> [Word8]) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
ByteString.unpack
  where
    go :: [a] -> Bool
go [] = Bool
True
    go (a
b : [a]
bs)
      | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x80 = [a] -> Bool
go [a]
bs
      | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0xc2 = Bool
False
      | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0xe0 = [a] -> Int -> Bool
cont [a]
bs Int
1
      | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0xf0 = [a] -> Int -> Bool
cont [a]
bs Int
2
      | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0xf5 = [a] -> Int -> Bool
cont [a]
bs Int
3
      | Bool
otherwise = Bool
False
    cont :: [a] -> Int -> Bool
cont [a]
bs (Int
0 :: Int) = [a] -> Bool
go [a]
bs
    cont [] Int
_ = Bool
False
    cont (a
b : [a]
bs) Int
n
      | a
b a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xc0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0x80 = [a] -> Int -> Bool
cont [a]
bs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      | Bool
otherwise = Bool
False

hexEncode :: ByteString -> ByteString
hexEncode :: ByteString -> ByteString
hexEncode = FilePath -> ByteString
ByteString.Char8.pack (FilePath -> ByteString)
-> (ByteString -> FilePath) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> FilePath) -> [Word8] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> FilePath
forall {a} {a}. (Integral a, Enum a) => a -> [a]
toHex ([Word8] -> FilePath)
-> (ByteString -> [Word8]) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
ByteString.unpack
  where
    toHex :: a -> [a]
toHex a
byte = [a -> a
forall {a} {a}. (Integral a, Enum a) => a -> a
digit (a
byte a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
16), a -> a
forall {a} {a}. (Integral a, Enum a) => a -> a
digit (a
byte a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
16)]
    digit :: a -> a
digit a
n
      | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 = Int -> a
forall a. Enum a => Int -> a
toEnum (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0')
      | Bool
otherwise = Int -> a
forall a. Enum a => Int -> a
toEnum (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'a')