Skip to content

Commit 998f21a

Browse files
robxphadej
robx
authored and
phadej
committedAug 24, 2024·
Add pipeline mode API
https://www.postgresql.org/docs/current/libpq-pipeline-mode.html - Test pipelineStatus in smoke test - Test pipeline mode API
·
v0.11.0.0
1 parent c24c8f4 commit 998f21a

File tree

12 files changed

+177
-27
lines changed

12 files changed

+177
-27
lines changed
 

‎.github/workflows/haskell-ci.yml

+4-2
Original file line numberDiff line numberDiff line change
@@ -94,6 +94,8 @@ jobs:
9494
chmod a+x "$HOME/.ghcup/bin/ghcup"
9595
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
9696
"$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
97+
apt-get update
98+
apt-get install -y libpq-dev
9799
env:
98100
HCKIND: ${{ matrix.compilerKind }}
99101
HCNAME: ${{ matrix.compiler }}
@@ -233,7 +235,7 @@ jobs:
233235
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
234236
- name: tests
235237
run: |
236-
$CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all
238+
$CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
237239
- name: cabal check
238240
run: |
239241
cd ${PKGDIR_postgresql_libpq} || false
@@ -244,7 +246,7 @@ jobs:
244246
${CABAL} -vnormal check
245247
- name: haddock
246248
run: |
247-
$CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
249+
$CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
248250
- name: unconstrained build
249251
run: |
250252
rm -f cabal.project.local

‎.github/workflows/simple.yml

+1
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ jobs:
3939
username: ci
4040
password: sw0rdfish
4141
database: test
42+
postgres-version: "14"
4243

4344
- name: Checkout
4445
uses: actions/checkout@v4

‎cabal.haskell-ci

+1-4
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,6 @@
11
branches: master
22
postgresql: True
3-
4-
-- due build-type: Custom
5-
test-output-direct: False
6-
haddock-components: libs
3+
apt: libpq-dev
74

85
constraint-set pkg-config
96
constraints: postgresql-libpq +use-pkg-config

‎postgresql-libpq-configure/configure

+1-1
Original file line numberDiff line numberDiff line change
@@ -3570,7 +3570,7 @@ then :
35703570
ac_cv_POSTGRESQL_LIBS="$POSTGRESQL_LIBS"
35713571
fi
35723572
3573-
postgresql_version_req=10.22
3573+
postgresql_version_req=14.12
35743574
found_postgresql="no"
35753575
35763576
POSTGRESQL_VERSION=""

‎postgresql-libpq-configure/configure.ac

+1-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ AC_CONFIG_MACRO_DIRS([m4])
55
AC_PROG_CC
66
AC_PROG_SED
77

8-
AX_LIB_POSTGRESQL([10.22])
8+
AX_LIB_POSTGRESQL([14.12])
99

1010
POSTGRESQL_EXTRA_LIBS="pq"
1111
POSTGRESQL_LIBDIR=$(echo "$POSTGRESQL_LDFLAGS"|$SED 's/-L//')

‎postgresql-libpq-configure/postgresql-libpq-configure.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.4
22
name: postgresql-libpq-configure
3-
version: 0.10.0.1
3+
version: 0.11
44
synopsis: low-level binding to libpq: configure based provider
55
description:
66
This is a binding to libpq: the C application

‎postgresql-libpq-pkgconfig/postgresql-libpq-pkgconfig.cabal

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.4
22
name: postgresql-libpq-pkgconfig
3-
version: 0.10
3+
version: 0.11
44
synopsis: low-level binding to libpq: pkg-config based provider
55
description:
66
This is a binding to libpq: the C application
@@ -35,7 +35,7 @@ extra-source-files: CHANGELOG.md
3535
library
3636
default-language: Haskell2010
3737
build-depends: base <5
38-
pkgconfig-depends: libpq >=10.22
38+
pkgconfig-depends: libpq >=14.12
3939

4040
source-repository head
4141
type: git

‎postgresql-libpq.cabal

+3-3
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.4
22
name: postgresql-libpq
3-
version: 0.10.2.0
3+
version: 0.11.0.0
44
synopsis: low-level binding to libpq
55
description:
66
This is a binding to libpq: the C application
@@ -81,10 +81,10 @@ library
8181
build-depends: Win32 >=2.2.0.2 && <2.15
8282

8383
if flag(use-pkg-config)
84-
build-depends: postgresql-libpq-pkgconfig ^>=0.10
84+
build-depends: postgresql-libpq-pkgconfig ^>=0.11
8585

8686
else
87-
build-depends: postgresql-libpq-configure ^>=0.10
87+
build-depends: postgresql-libpq-configure ^>=0.11
8888

8989
build-tool-depends: hsc2hs:hsc2hs >=0.68.5
9090

‎src/Database/PostgreSQL/LibPQ.hs

+63
Original file line numberDiff line numberDiff line change
@@ -171,6 +171,15 @@ module Database.PostgreSQL.LibPQ
171171
, FlushStatus(..)
172172
, flush
173173

174+
-- * Pipeline Mode
175+
-- $pipelinemode
176+
, PipelineStatus(..)
177+
, pipelineStatus
178+
, enterPipelineMode
179+
, exitPipelineMode
180+
, pipelineSync
181+
, sendFlushRequest
182+
174183
-- * Cancelling Queries in Progress
175184
-- $cancel
176185
, Cancel
@@ -1640,6 +1649,60 @@ flush connection =
16401649
1 -> return FlushWriting
16411650
_ -> return FlushFailed
16421651

1652+
-- $pipelinemode
1653+
-- These functions control behaviour in pipeline mode.
1654+
--
1655+
-- Pipeline mode allows applications to send a query
1656+
-- without having to read the result of the previously
1657+
-- sent query. Taking advantage of the pipeline mode,
1658+
-- a client will wait less for the server, since multiple
1659+
-- queries/results can be sent/received in
1660+
-- a single network transaction.
1661+
1662+
-- | Returns the current pipeline mode status of the libpq connection.
1663+
--
1664+
-- @since 0.11.0.0
1665+
pipelineStatus :: Connection
1666+
-> IO PipelineStatus
1667+
pipelineStatus connection = do
1668+
stat <- withConn connection c_PQpipelineStatus
1669+
maybe
1670+
(fail $ "Unknown pipeline status " ++ show stat)
1671+
return
1672+
(fromCInt stat)
1673+
1674+
-- | Causes a connection to enter pipeline mode if it is currently idle or already in pipeline mode.
1675+
--
1676+
-- @since 0.11.0.0
1677+
enterPipelineMode :: Connection
1678+
-> IO Bool
1679+
enterPipelineMode connection =
1680+
enumFromConn connection c_PQenterPipelineMode
1681+
1682+
-- | Causes a connection to exit pipeline mode if it is currently in pipeline mode with an empty queue and no pending results.
1683+
--
1684+
-- @since 0.11.0.0
1685+
exitPipelineMode :: Connection
1686+
-> IO Bool
1687+
exitPipelineMode connection =
1688+
enumFromConn connection c_PQexitPipelineMode
1689+
1690+
-- | Marks a synchronization point in a pipeline by sending a sync message and flushing the send buffer. This serves as the delimiter of an implicit transaction and an error recovery point>
1691+
--
1692+
-- @since 0.11.0.0
1693+
pipelineSync :: Connection
1694+
-> IO Bool
1695+
pipelineSync connection =
1696+
enumFromConn connection c_PQpipelineSync
1697+
1698+
-- | Sends a request for the server to flush its output buffer.
1699+
--
1700+
-- @since 0.11.0.0
1701+
sendFlushRequest :: Connection
1702+
-> IO Bool
1703+
sendFlushRequest connection =
1704+
enumFromConn connection c_PQsendFlushRequest
1705+
16431706

16441707
-- $cancel
16451708
-- A client application can request cancellation of a command that is

‎src/Database/PostgreSQL/LibPQ/Enums.hsc

+52-12
Original file line numberDiff line numberDiff line change
@@ -37,23 +37,42 @@ data ExecStatus
3737
| NonfatalError -- ^ A nonfatal error (a notice or
3838
-- warning) occurred.
3939
| FatalError -- ^ A fatal error occurred.
40-
| SingleTuple -- ^ The PGresult contains a single result tuple
40+
| SingleTuple -- ^ The 'Result' contains a single result tuple
4141
-- from the current command. This status occurs
4242
-- only when single-row mode has been selected
4343
-- for the query.
44+
45+
| PipelineSync -- ^ The 'Result' represents a synchronization
46+
-- point in pipeline mode, requested by
47+
-- 'pipelineSync'. This status occurs only
48+
-- when pipeline mode has been selected.
49+
--
50+
-- @since 0.11.0.0
51+
52+
| PipelineAbort -- ^ The 'Result' represents a pipeline that
53+
-- has received an error from the server.
54+
-- 'getResult' must be called repeatedly,
55+
-- and each time it will return this status
56+
-- code until the end of the current pipeline,
57+
-- at which point it will return 'PipelineSync'
58+
-- and normal processing can resume.
59+
--
60+
-- @since 0.11.0.0
4461
deriving (Eq, Show)
4562

4663
instance FromCInt ExecStatus where
47-
fromCInt (#const PGRES_EMPTY_QUERY) = Just EmptyQuery
48-
fromCInt (#const PGRES_COMMAND_OK) = Just CommandOk
49-
fromCInt (#const PGRES_TUPLES_OK) = Just TuplesOk
50-
fromCInt (#const PGRES_COPY_OUT) = Just CopyOut
51-
fromCInt (#const PGRES_COPY_IN) = Just CopyIn
52-
fromCInt (#const PGRES_COPY_BOTH) = Just CopyBoth
53-
fromCInt (#const PGRES_BAD_RESPONSE) = Just BadResponse
54-
fromCInt (#const PGRES_NONFATAL_ERROR) = Just NonfatalError
55-
fromCInt (#const PGRES_FATAL_ERROR) = Just FatalError
56-
fromCInt (#const PGRES_SINGLE_TUPLE) = Just SingleTuple
64+
fromCInt (#const PGRES_EMPTY_QUERY) = Just EmptyQuery
65+
fromCInt (#const PGRES_COMMAND_OK) = Just CommandOk
66+
fromCInt (#const PGRES_TUPLES_OK) = Just TuplesOk
67+
fromCInt (#const PGRES_COPY_OUT) = Just CopyOut
68+
fromCInt (#const PGRES_COPY_IN) = Just CopyIn
69+
fromCInt (#const PGRES_COPY_BOTH) = Just CopyBoth
70+
fromCInt (#const PGRES_BAD_RESPONSE) = Just BadResponse
71+
fromCInt (#const PGRES_NONFATAL_ERROR) = Just NonfatalError
72+
fromCInt (#const PGRES_FATAL_ERROR) = Just FatalError
73+
fromCInt (#const PGRES_SINGLE_TUPLE) = Just SingleTuple
74+
fromCInt (#const PGRES_PIPELINE_SYNC) = Just PipelineSync
75+
fromCInt (#const PGRES_PIPELINE_ABORTED) = Just PipelineAbort
5776
fromCInt _ = Nothing
5877

5978
instance ToCInt ExecStatus where
@@ -67,6 +86,8 @@ instance ToCInt ExecStatus where
6786
toCInt NonfatalError = (#const PGRES_NONFATAL_ERROR)
6887
toCInt FatalError = (#const PGRES_FATAL_ERROR)
6988
toCInt SingleTuple = (#const PGRES_SINGLE_TUPLE)
89+
toCInt PipelineSync = (#const PGRES_PIPELINE_SYNC)
90+
toCInt PipelineAbort = (#const PGRES_PIPELINE_ABORTED)
7091

7192

7293
data FieldCode
@@ -230,7 +251,7 @@ instance FromCInt ConnStatus where
230251
fromCInt (#const CONNECTION_SSL_STARTUP) = return ConnectionSSLStartup
231252
-- fromCInt (#const CONNECTION_NEEDED) = return ConnectionNeeded
232253
fromCInt _ = Nothing
233-
254+
234255

235256
data TransactionStatus
236257
= TransIdle -- ^ currently idle
@@ -263,6 +284,25 @@ instance FromCInt Format where
263284
fromCInt 1 = Just Binary
264285
fromCInt _ = Nothing
265286

287+
288+
-- |
289+
--
290+
-- @since 0.11.0.0
291+
data PipelineStatus
292+
= PipelineOn -- ^ The 'Connection' is in pipeline mode.
293+
| PipelineOff -- ^ The 'Connection' is /not/ in pipeline mode.
294+
| PipelineAborted -- ^ The 'Connection' is in pipeline mode and an error
295+
-- occurred while processing the current pipeline. The
296+
-- aborted flag is cleared when 'getResult' returns a
297+
-- result with status 'PipelineSync'.
298+
deriving (Eq, Show)
299+
300+
instance FromCInt PipelineStatus where
301+
fromCInt (#const PQ_PIPELINE_ON) = return PipelineOn
302+
fromCInt (#const PQ_PIPELINE_OFF) = return PipelineOff
303+
fromCInt (#const PQ_PIPELINE_ABORTED) = return PipelineAborted
304+
fromCInt _ = Nothing
305+
266306
-------------------------------------------------------------------------------
267307
-- System.IO enumerations
268308
-------------------------------------------------------------------------------

‎src/Database/PostgreSQL/LibPQ/FFI.hs

+15
Original file line numberDiff line numberDiff line change
@@ -302,6 +302,21 @@ foreign import capi "hs-libpq.h &PQfreemem"
302302
foreign import capi "hs-libpq.h PQfreemem"
303303
c_PQfreemem :: Ptr a -> IO ()
304304

305+
foreign import capi "hs-libpq.h PQpipelineStatus"
306+
c_PQpipelineStatus :: Ptr PGconn -> IO CInt
307+
308+
foreign import capi "hs-libpq.h PQenterPipelineMode"
309+
c_PQenterPipelineMode :: Ptr PGconn -> IO CInt
310+
311+
foreign import capi "hs-libpq.h PQexitPipelineMode"
312+
c_PQexitPipelineMode :: Ptr PGconn -> IO CInt
313+
314+
foreign import capi "hs-libpq.h PQpipelineSync"
315+
c_PQpipelineSync :: Ptr PGconn -> IO CInt
316+
317+
foreign import capi "hs-libpq.h PQsendFlushRequest"
318+
c_PQsendFlushRequest :: Ptr PGconn -> IO CInt
319+
305320
-------------------------------------------------------------------------------
306321
-- FFI imports: noticebuffers
307322
-------------------------------------------------------------------------------

‎test/Smoke.hs

+33-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@ import Control.Monad (unless)
55
import Data.Foldable (toList)
66
import Database.PostgreSQL.LibPQ
77
import System.Environment (getEnvironment)
8-
import System.Exit (exitFailure)
98
import Test.Tasty (defaultMain, testGroup)
109
import Test.Tasty.HUnit (assertEqual, testCaseSteps)
1110

@@ -18,6 +17,7 @@ main = do
1817
withConnstring $ \connString -> defaultMain $ testGroup "postgresql-libpq"
1918
[ testCaseSteps "smoke" $ smoke connString
2019
, testCaseSteps "issue54" $ issue54 connString
20+
, testCaseSteps "pipeline" $ testPipeline connString
2121
]
2222

2323
withConnstring :: (BS8.ByteString -> IO ()) -> IO ()
@@ -57,6 +57,7 @@ smoke connstring info = do
5757
transactionStatus conn >>= infoShow
5858
protocolVersion conn >>= infoShow
5959
serverVersion conn >>= infoShow
60+
pipelineStatus conn >>= infoShow
6061

6162
s <- status conn
6263
assertEqual "connection not ok" ConnectionOk s
@@ -87,3 +88,34 @@ issue54 connString info = do
8788

8889
assertEqual "fst not null" BS.empty val1
8990
assertEqual "snd not null" BS.empty val2
91+
92+
testPipeline :: BS8.ByteString -> (String -> IO ()) -> IO ()
93+
testPipeline connstring info = do
94+
conn <- connectdb connstring
95+
96+
setnonblocking conn True `shouldReturn` True
97+
enterPipelineMode conn `shouldReturn` True
98+
pipelineStatus conn `shouldReturn` PipelineOn
99+
sendQueryParams conn (BS8.pack "select 1") [] Text `shouldReturn` True
100+
sendQueryParams conn (BS8.pack "select 2") [] Text `shouldReturn` True
101+
pipelineSync conn `shouldReturn` True
102+
103+
Just r1 <- getResult conn
104+
resultStatus r1 `shouldReturn` TuplesOk
105+
getvalue r1 0 0 `shouldReturn` Just (BS8.pack "1")
106+
Nothing <- getResult conn
107+
108+
Just r2 <- getResult conn
109+
getvalue r2 0 0 `shouldReturn` Just (BS8.pack "2")
110+
Nothing <- getResult conn
111+
112+
Just r3 <- getResult conn
113+
resultStatus r3 `shouldReturn` PipelineSync
114+
115+
finish conn
116+
where
117+
shouldBe r value = assertEqual "shouldBe" r value
118+
119+
shouldReturn action value = do
120+
r <- action
121+
r `shouldBe` value

0 commit comments

Comments
 (0)
Please sign in to comment.