diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2026, Nikita Volkov + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the "Software"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,80 @@ +# pqi-conformance + +[![Hackage](https://img.shields.io/hackage/v/pqi-conformance.svg)](https://hackage.haskell.org/package/pqi-conformance) +[![Continuous Haddock](https://img.shields.io/badge/haddock-master-blue)](https://nikita-volkov.github.io/pqi-conformance/) + +A reusable [`hspec`](https://hackage.haskell.org/package/hspec) toolkit that +checks any [`pqi`](https://github.com/nikita-volkov/pqi) adapter against the +battle-tested [`postgresql-libpq`](https://hackage.haskell.org/package/postgresql-libpq) +library as a reference. + +## Goal: full libpq fidelity + +The purpose of this suite is to enforce **byte-identical output to `libpq`** +for every protocol-derived value. This means error message strings, notice +text, result status, field metadata, cell data, and all structured error fields +must all match `libpq`'s output exactly, not just in shape or presence. + +The suite runs the same operation on the candidate adapter and on a direct +[`postgresql-libpq`](https://hackage.haskell.org/package/postgresql-libpq) +reference connection (the fidelity reference, which delegates directly to the C +`libpq` library), connected to the same throwaway PostgreSQL container. It then +asserts that the protocol-derived observations are equal. + +### Structurally incomparable values + +A small number of values are **structurally incomparable across connections** +and are handled differently: + +- **`backendPID`** — the OS process ID of the backend. Each connection gets a + distinct backend, so the two PIDs will never match. The spec asserts `> 0` + independently for each adapter. +- **`socket`** — the file descriptor of the client socket. Also + connection-specific. Covered only by its own presence check. +- **`Notify.bePid`** — the PID of the notifying backend. Since each adapter's + connection has its own backend, cross-adapter comparison would always fail. + Instead, each adapter asserts independently that `notification.bePid == + backendPID connection` (a within-connection assertion that verifies the PID + field is correctly populated). + +These omissions are a structural constraint of the differential testing +approach, not an intentional leniency in the suite. All other values — +including error message text, notice text, and cancel error text — are compared +in full. + +## Structure: one module per operation + +The suite is organised as **one spec module per API operation**, under +`Pqi.Conformance.Operation.*` — `...Operation.Exec`, `...Operation.ExecParams`, +`...Operation.LoSeek`, `...Operation.Fnumber`, and so on, one for every public +method of `Pqi.IsConnection`, `Pqi.IsResult`, and `Pqi.IsCancel`, +plus the standalone `Pqi.unescapeBytea`. Each module holds the differential +scenarios that exercise that one operation (its happy paths, its edge cases, +and its error paths). Shared scenario fragments live in +`Pqi.Conformance.Scenario`. + +## Usage + +An adapter's own test suite is a one-liner — it hands `specs` a `Proxy` of its +connection type and `specs` takes care of booting the container and running the +whole battery (every operation, the coverage meta-test, and SCRAM): + +```haskell +module Main (main) where + +import Data.Proxy (Proxy (..)) +import Pqi.Conformance (specs) +import MyAdapter (MyConnection) +import Test.Hspec (hspec) + +main :: IO () +main = hspec (specs (Proxy @MyConnection)) +``` + +`MyConnection` only needs a `Pqi.IsConnection` instance; the candidate and +the `postgresql-libpq` reference are both driven through that interface. + +## Contributing + +Contributions extending the suite are very welcome. The more thoroughly we +cover the operations, the more confidence we can have in the adapters. diff --git a/pqi-conformance.cabal b/pqi-conformance.cabal new file mode 100644 --- /dev/null +++ b/pqi-conformance.cabal @@ -0,0 +1,213 @@ +cabal-version: 3.0 +name: pqi-conformance +version: 0.0.1.0 +category: Database, PostgreSQL, Testing +synopsis: Differential conformance tests for pqi adapters +description: + A reusable @hspec@ toolkit that checks any @pqi@ 'Pqi.IsConnection' + adapter against the FFI reference adapter. It boots a throwaway PostgreSQL + container (via @testcontainers@), runs the same operation on the candidate and + the FFI connection, and asserts that the protocol-derived observations match. + + . + + Each adapter's own test suite reuses these spec builders, wiring itself in as + the candidate. + +homepage: https://github.com/nikita-volkov/pqi-conformance +bug-reports: https://github.com/nikita-volkov/pqi-conformance/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2026, Nikita Volkov +license: MIT +license-file: LICENSE +extra-doc-files: + CHANGELOG.md + LICENSE + README.md + +source-repository head + type: git + location: https://github.com/nikita-volkov/pqi-conformance + +common base + default-language: Haskell2010 + default-extensions: + ApplicativeDo + BangPatterns + BinaryLiterals + BlockArguments + ConstraintKinds + DataKinds + DefaultSignatures + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveTraversable + DerivingStrategies + DerivingVia + DuplicateRecordFields + EmptyDataDecls + ExistentialQuantification + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + LambdaCase + LiberalTypeSynonyms + MagicHash + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NoFieldSelectors + NoImplicitPrelude + NoMonomorphismRestriction + NumericUnderscores + OverloadedRecordDot + OverloadedStrings + ParallelListComp + PatternGuards + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + StrictData + TemplateHaskell + TupleSections + TypeApplications + TypeFamilies + TypeOperators + UnboxedTuples + ViewPatterns + +common test + import: base + ghc-options: + -threaded + -with-rtsopts=-N + +library + import: base + hs-source-dirs: src/library + exposed-modules: + Pqi.Conformance + + other-modules: + Pqi.Conformance.Harness + Pqi.Conformance.Observation + Pqi.Conformance.Operation.BackendPID + Pqi.Conformance.Operation.Cancel + Pqi.Conformance.Operation.CancelCleanup + Pqi.Conformance.Operation.ClientEncoding + Pqi.Conformance.Operation.CmdStatus + Pqi.Conformance.Operation.CmdTuples + Pqi.Conformance.Operation.Connectdb + Pqi.Conformance.Operation.ConnectionNeedsPassword + Pqi.Conformance.Operation.ConnectionUsedPassword + Pqi.Conformance.Operation.ConnectPoll + Pqi.Conformance.Operation.ConnectStart + Pqi.Conformance.Operation.ConsumeInput + Pqi.Conformance.Operation.Db + Pqi.Conformance.Operation.DescribePortal + Pqi.Conformance.Operation.DescribePrepared + Pqi.Conformance.Operation.DisableNoticeReporting + Pqi.Conformance.Operation.EnableNoticeReporting + Pqi.Conformance.Operation.EnterPipelineMode + Pqi.Conformance.Operation.ErrorMessage + Pqi.Conformance.Operation.EscapeByteaConn + Pqi.Conformance.Operation.EscapeIdentifier + Pqi.Conformance.Operation.EscapeStringConn + Pqi.Conformance.Operation.Exec + Pqi.Conformance.Operation.ExecParams + Pqi.Conformance.Operation.ExecPrepared + Pqi.Conformance.Operation.ExitPipelineMode + Pqi.Conformance.Operation.Fformat + Pqi.Conformance.Operation.Finish + Pqi.Conformance.Operation.Flush + Pqi.Conformance.Operation.Fmod + Pqi.Conformance.Operation.Fname + Pqi.Conformance.Operation.Fnumber + Pqi.Conformance.Operation.Fsize + Pqi.Conformance.Operation.Ftable + Pqi.Conformance.Operation.Ftablecol + Pqi.Conformance.Operation.Ftype + Pqi.Conformance.Operation.GetCancel + Pqi.Conformance.Operation.GetCopyData + Pqi.Conformance.Operation.Getisnull + Pqi.Conformance.Operation.Getlength + Pqi.Conformance.Operation.GetNotice + Pqi.Conformance.Operation.GetResult + Pqi.Conformance.Operation.Getvalue + Pqi.Conformance.Operation.GetvalueCopy + Pqi.Conformance.Operation.Host + Pqi.Conformance.Operation.IsBusy + Pqi.Conformance.Operation.Isnonblocking + Pqi.Conformance.Operation.IsNullConnection + Pqi.Conformance.Operation.LoClose + Pqi.Conformance.Operation.LoCreat + Pqi.Conformance.Operation.LoCreate + Pqi.Conformance.Operation.LoExport + Pqi.Conformance.Operation.LoImport + Pqi.Conformance.Operation.LoImportWithOid + Pqi.Conformance.Operation.LoOpen + Pqi.Conformance.Operation.LoRead + Pqi.Conformance.Operation.LoSeek + Pqi.Conformance.Operation.LoTell + Pqi.Conformance.Operation.LoTruncate + Pqi.Conformance.Operation.LoUnlink + Pqi.Conformance.Operation.LoWrite + Pqi.Conformance.Operation.NewNullConnection + Pqi.Conformance.Operation.Nfields + Pqi.Conformance.Operation.Notifies + Pqi.Conformance.Operation.Nparams + Pqi.Conformance.Operation.Ntuples + Pqi.Conformance.Operation.Options + Pqi.Conformance.Operation.ParameterStatus + Pqi.Conformance.Operation.Paramtype + Pqi.Conformance.Operation.Pass + Pqi.Conformance.Operation.PipelineStatus + Pqi.Conformance.Operation.PipelineSync + Pqi.Conformance.Operation.Port + Pqi.Conformance.Operation.Prepare + Pqi.Conformance.Operation.ProtocolVersion + Pqi.Conformance.Operation.PutCopyData + Pqi.Conformance.Operation.PutCopyEnd + Pqi.Conformance.Operation.Reset + Pqi.Conformance.Operation.ResetPoll + Pqi.Conformance.Operation.ResetStart + Pqi.Conformance.Operation.ResultErrorField + Pqi.Conformance.Operation.ResultErrorMessage + Pqi.Conformance.Operation.ResultStatus + Pqi.Conformance.Operation.SendDescribePortal + Pqi.Conformance.Operation.SendDescribePrepared + Pqi.Conformance.Operation.SendFlushRequest + Pqi.Conformance.Operation.SendPrepare + Pqi.Conformance.Operation.SendQuery + Pqi.Conformance.Operation.SendQueryParams + Pqi.Conformance.Operation.SendQueryPrepared + Pqi.Conformance.Operation.ServerVersion + Pqi.Conformance.Operation.SetClientEncoding + Pqi.Conformance.Operation.SetErrorVerbosity + Pqi.Conformance.Operation.Setnonblocking + Pqi.Conformance.Operation.SetSingleRowMode + Pqi.Conformance.Operation.Socket + Pqi.Conformance.Operation.Status + Pqi.Conformance.Operation.TransactionStatus + Pqi.Conformance.Operation.UnsafeFreeResult + Pqi.Conformance.Operation.User + Pqi.Conformance.Prelude + Pqi.Conformance.Reference + Pqi.Conformance.Scenario + + build-depends: + base >=4.11 && <5, + bytestring >=0.10 && <0.13, + containers >=0.6 && <0.9, + directory >=1.3 && <1.4, + hspec >=2.11 && <2.12, + postgresql-libpq >=0.11 && <0.12, + pqi ^>=0, + testcontainers-postgresql ^>=0.2, + text >=1.2 && <3, diff --git a/src/library/Pqi/Conformance.hs b/src/library/Pqi/Conformance.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance.hs @@ -0,0 +1,240 @@ +-- | A reusable differential-testing toolkit for @pqi@ adapters. +-- +-- An adapter's test suite calls 'specs' with a @'Proxy' \@MyConnection@. The +-- battery runs the same operation on the candidate and on the FFI reference +-- and asserts that the protocol-derived observations match. +-- +-- The throwaway PostgreSQL container lifecycle is baked into 'specs', so +-- adapter test suites only need @hspec (specs (Proxy \@MyConnection))@; they +-- don't have to know about @testcontainers@ at all. The SCRAM-SHA-256 +-- authentication spec is part of the @connectdb@ group and boots its own +-- password-auth container. +module Pqi.Conformance + ( specs, + ) +where + +import Pqi (IsConnection) +import Pqi.Conformance.Harness +import qualified Pqi.Conformance.Operation.BackendPID as BackendPID +import qualified Pqi.Conformance.Operation.Cancel as Cancel +import qualified Pqi.Conformance.Operation.CancelCleanup as CancelCleanup +import qualified Pqi.Conformance.Operation.ClientEncoding as ClientEncoding +import qualified Pqi.Conformance.Operation.CmdStatus as CmdStatus +import qualified Pqi.Conformance.Operation.CmdTuples as CmdTuples +import qualified Pqi.Conformance.Operation.ConnectPoll as ConnectPoll +import qualified Pqi.Conformance.Operation.ConnectStart as ConnectStart +import qualified Pqi.Conformance.Operation.Connectdb as Connectdb +import qualified Pqi.Conformance.Operation.ConnectionNeedsPassword as ConnectionNeedsPassword +import qualified Pqi.Conformance.Operation.ConnectionUsedPassword as ConnectionUsedPassword +import qualified Pqi.Conformance.Operation.ConsumeInput as ConsumeInput +import qualified Pqi.Conformance.Operation.Db as Db +import qualified Pqi.Conformance.Operation.DescribePortal as DescribePortal +import qualified Pqi.Conformance.Operation.DescribePrepared as DescribePrepared +import qualified Pqi.Conformance.Operation.DisableNoticeReporting as DisableNoticeReporting +import qualified Pqi.Conformance.Operation.EnableNoticeReporting as EnableNoticeReporting +import qualified Pqi.Conformance.Operation.EnterPipelineMode as EnterPipelineMode +import qualified Pqi.Conformance.Operation.ErrorMessage as ErrorMessage +import qualified Pqi.Conformance.Operation.EscapeByteaConn as EscapeByteaConn +import qualified Pqi.Conformance.Operation.EscapeIdentifier as EscapeIdentifier +import qualified Pqi.Conformance.Operation.EscapeStringConn as EscapeStringConn +import qualified Pqi.Conformance.Operation.Exec as Exec +import qualified Pqi.Conformance.Operation.ExecParams as ExecParams +import qualified Pqi.Conformance.Operation.ExecPrepared as ExecPrepared +import qualified Pqi.Conformance.Operation.ExitPipelineMode as ExitPipelineMode +import qualified Pqi.Conformance.Operation.Fformat as Fformat +import qualified Pqi.Conformance.Operation.Finish as Finish +import qualified Pqi.Conformance.Operation.Flush as Flush +import qualified Pqi.Conformance.Operation.Fmod as Fmod +import qualified Pqi.Conformance.Operation.Fname as Fname +import qualified Pqi.Conformance.Operation.Fnumber as Fnumber +import qualified Pqi.Conformance.Operation.Fsize as Fsize +import qualified Pqi.Conformance.Operation.Ftable as Ftable +import qualified Pqi.Conformance.Operation.Ftablecol as Ftablecol +import qualified Pqi.Conformance.Operation.Ftype as Ftype +import qualified Pqi.Conformance.Operation.GetCancel as GetCancel +import qualified Pqi.Conformance.Operation.GetCopyData as GetCopyData +import qualified Pqi.Conformance.Operation.GetNotice as GetNotice +import qualified Pqi.Conformance.Operation.GetResult as GetResult +import qualified Pqi.Conformance.Operation.Getisnull as Getisnull +import qualified Pqi.Conformance.Operation.Getlength as Getlength +import qualified Pqi.Conformance.Operation.Getvalue as Getvalue +import qualified Pqi.Conformance.Operation.GetvalueCopy as GetvalueCopy +import qualified Pqi.Conformance.Operation.Host as Host +import qualified Pqi.Conformance.Operation.IsBusy as IsBusy +import qualified Pqi.Conformance.Operation.IsNullConnection as IsNullConnection +import qualified Pqi.Conformance.Operation.Isnonblocking as Isnonblocking +import qualified Pqi.Conformance.Operation.LoClose as LoClose +import qualified Pqi.Conformance.Operation.LoCreat as LoCreat +import qualified Pqi.Conformance.Operation.LoCreate as LoCreate +import qualified Pqi.Conformance.Operation.LoExport as LoExport +import qualified Pqi.Conformance.Operation.LoImport as LoImport +import qualified Pqi.Conformance.Operation.LoImportWithOid as LoImportWithOid +import qualified Pqi.Conformance.Operation.LoOpen as LoOpen +import qualified Pqi.Conformance.Operation.LoRead as LoRead +import qualified Pqi.Conformance.Operation.LoSeek as LoSeek +import qualified Pqi.Conformance.Operation.LoTell as LoTell +import qualified Pqi.Conformance.Operation.LoTruncate as LoTruncate +import qualified Pqi.Conformance.Operation.LoUnlink as LoUnlink +import qualified Pqi.Conformance.Operation.LoWrite as LoWrite +import qualified Pqi.Conformance.Operation.NewNullConnection as NewNullConnection +import qualified Pqi.Conformance.Operation.Nfields as Nfields +import qualified Pqi.Conformance.Operation.Notifies as Notifies +import qualified Pqi.Conformance.Operation.Nparams as Nparams +import qualified Pqi.Conformance.Operation.Ntuples as Ntuples +import qualified Pqi.Conformance.Operation.Options as Options +import qualified Pqi.Conformance.Operation.ParameterStatus as ParameterStatus +import qualified Pqi.Conformance.Operation.Paramtype as Paramtype +import qualified Pqi.Conformance.Operation.Pass as Pass +import qualified Pqi.Conformance.Operation.PipelineStatus as PipelineStatus +import qualified Pqi.Conformance.Operation.PipelineSync as PipelineSync +import qualified Pqi.Conformance.Operation.Port as Port +import qualified Pqi.Conformance.Operation.Prepare as Prepare +import qualified Pqi.Conformance.Operation.ProtocolVersion as ProtocolVersion +import qualified Pqi.Conformance.Operation.PutCopyData as PutCopyData +import qualified Pqi.Conformance.Operation.PutCopyEnd as PutCopyEnd +import qualified Pqi.Conformance.Operation.Reset as Reset +import qualified Pqi.Conformance.Operation.ResetPoll as ResetPoll +import qualified Pqi.Conformance.Operation.ResetStart as ResetStart +import qualified Pqi.Conformance.Operation.ResultErrorField as ResultErrorField +import qualified Pqi.Conformance.Operation.ResultErrorMessage as ResultErrorMessage +import qualified Pqi.Conformance.Operation.ResultStatus as ResultStatus +import qualified Pqi.Conformance.Operation.SendDescribePortal as SendDescribePortal +import qualified Pqi.Conformance.Operation.SendDescribePrepared as SendDescribePrepared +import qualified Pqi.Conformance.Operation.SendFlushRequest as SendFlushRequest +import qualified Pqi.Conformance.Operation.SendPrepare as SendPrepare +import qualified Pqi.Conformance.Operation.SendQuery as SendQuery +import qualified Pqi.Conformance.Operation.SendQueryParams as SendQueryParams +import qualified Pqi.Conformance.Operation.SendQueryPrepared as SendQueryPrepared +import qualified Pqi.Conformance.Operation.ServerVersion as ServerVersion +import qualified Pqi.Conformance.Operation.SetClientEncoding as SetClientEncoding +import qualified Pqi.Conformance.Operation.SetErrorVerbosity as SetErrorVerbosity +import qualified Pqi.Conformance.Operation.SetSingleRowMode as SetSingleRowMode +import qualified Pqi.Conformance.Operation.Setnonblocking as Setnonblocking +import qualified Pqi.Conformance.Operation.Socket as Socket +import qualified Pqi.Conformance.Operation.Status as Status +import qualified Pqi.Conformance.Operation.TransactionStatus as TransactionStatus +import qualified Pqi.Conformance.Operation.UnsafeFreeResult as UnsafeFreeResult +import qualified Pqi.Conformance.Operation.User as User +import Pqi.Conformance.Prelude +import Test.Hspec + +-- | The full conformance battery: every per-operation spec under one shared +-- trust-auth container, plus SCRAM-SHA-256 authentication (which boots its own +-- password-auth container). Every operation spec is differential against the +-- FFI reference. +specs :: (IsConnection c) => Proxy c -> Spec +specs proxy = parallel do + containerHook do + -- Connection lifecycle + Connectdb.spec proxy + ConnectStart.spec proxy + ConnectPoll.spec proxy + NewNullConnection.spec proxy + IsNullConnection.spec proxy + Finish.spec proxy + Reset.spec proxy + ResetStart.spec proxy + ResetPoll.spec proxy + -- Connection information accessors + Db.spec proxy + User.spec proxy + Pass.spec proxy + Host.spec proxy + Port.spec proxy + Options.spec proxy + Status.spec proxy + TransactionStatus.spec proxy + ParameterStatus.spec proxy + ProtocolVersion.spec proxy + ServerVersion.spec proxy + ErrorMessage.spec proxy + Socket.spec proxy + BackendPID.spec proxy + ConnectionNeedsPassword.spec proxy + ConnectionUsedPassword.spec proxy + -- Querying + Exec.spec proxy + ExecParams.spec proxy + Prepare.spec proxy + ExecPrepared.spec proxy + DescribePrepared.spec proxy + DescribePortal.spec proxy + -- Escaping + EscapeStringConn.spec proxy + EscapeByteaConn.spec proxy + EscapeIdentifier.spec proxy + -- Asynchronous command processing + SendQuery.spec proxy + SendQueryParams.spec proxy + SendPrepare.spec proxy + SendQueryPrepared.spec proxy + SendDescribePrepared.spec proxy + SendDescribePortal.spec proxy + GetResult.spec proxy + ConsumeInput.spec proxy + IsBusy.spec proxy + Setnonblocking.spec proxy + Isnonblocking.spec proxy + SetSingleRowMode.spec proxy + Flush.spec proxy + -- Pipelining + PipelineStatus.spec proxy + EnterPipelineMode.spec proxy + ExitPipelineMode.spec proxy + PipelineSync.spec proxy + SendFlushRequest.spec proxy + -- Cancellation + GetCancel.spec proxy + Cancel.spec proxy + CancelCleanup.spec proxy + -- Notifications and notices + Notifies.spec proxy + DisableNoticeReporting.spec proxy + EnableNoticeReporting.spec proxy + GetNotice.spec proxy + -- Copy sub-protocol + PutCopyData.spec proxy + PutCopyEnd.spec proxy + GetCopyData.spec proxy + -- Large objects + LoCreat.spec proxy + LoCreate.spec proxy + LoImport.spec proxy + LoImportWithOid.spec proxy + LoExport.spec proxy + LoOpen.spec proxy + LoWrite.spec proxy + LoRead.spec proxy + LoSeek.spec proxy + LoTell.spec proxy + LoTruncate.spec proxy + LoClose.spec proxy + LoUnlink.spec proxy + -- Connection control + ClientEncoding.spec proxy + SetClientEncoding.spec proxy + SetErrorVerbosity.spec proxy + -- Result inspection + ResultStatus.spec proxy + ResultErrorMessage.spec proxy + ResultErrorField.spec proxy + UnsafeFreeResult.spec proxy + Ntuples.spec proxy + Nfields.spec proxy + Fname.spec proxy + Fnumber.spec proxy + Ftable.spec proxy + Ftablecol.spec proxy + Fformat.spec proxy + Ftype.spec proxy + Fmod.spec proxy + Fsize.spec proxy + Getvalue.spec proxy + GetvalueCopy.spec proxy + Getisnull.spec proxy + Getlength.spec proxy + Nparams.spec proxy + Paramtype.spec proxy + CmdStatus.spec proxy + CmdTuples.spec proxy diff --git a/src/library/Pqi/Conformance/Harness.hs b/src/library/Pqi/Conformance/Harness.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Harness.hs @@ -0,0 +1,99 @@ +-- | The differential-testing harness: a throwaway PostgreSQL container and +-- the comparison combinators. +module Pqi.Conformance.Harness + ( -- * Container + containerHook, + + -- * Comparison + differential, + differentialConnect, + ) +where + +import Control.Exception (bracket, bracket_) +import qualified Data.ByteString.Char8 as ByteString.Char8 +import qualified Data.Text as Text +import Data.Unique (hashUnique, newUnique) +import Pqi (IsConnection (..)) +import Pqi.Conformance.Prelude +import Pqi.Conformance.Reference (Reference) +import Test.Hspec +import qualified TestcontainersPostgresql as TcPg + +-- | Boot a single trust-auth PostgreSQL container for the whole spec tree and +-- hand each example a ready conninfo string. +containerHook :: SpecWith ByteString -> Spec +containerHook = aroundAll (TcPg.run config) . aroundWith withConninfo + where + config = + TcPg.Config + { TcPg.tagName = "postgres:17", + TcPg.forwardLogs = False, + TcPg.auth = TcPg.TrustAuth + } + withConninfo action (host, port) = action (conninfo host port) + conninfo host port = + ByteString.Char8.pack + ( "host=" + <> Text.unpack host + <> " port=" + <> show port + <> " user=postgres dbname=postgres" + ) + +-- | Run a scenario on both the candidate and the FFI reference (each on its own +-- fresh connection to the same database) and assert that the two observations +-- are equal. +-- +-- Each call creates a fresh database for the scenario and drops it afterwards, +-- so tests are isolated even when the container is shared. +differential :: + forall c a. + (Eq a, Show a, IsConnection c, HasCallStack) => + Proxy c -> + ByteString -> + (forall c'. (IsConnection c') => c' -> IO a) -> + Expectation +differential _ adminConninfo scenario = + withTestDb adminConninfo \testConninfo -> do + candidate <- bracket (connectdb testConninfo :: IO c) finish scenario + reference <- bracket (connectdb testConninfo :: IO Reference) finish scenario + candidate `shouldBe` reference + +-- Create a uniquely named database, run the action against it, and drop it on +-- exit (including on exception). The admin conninfo must point to an existing +-- database (e.g. @dbname=postgres@); the test conninfo appended with the new +-- database name is passed to the action. In libpq keyword=value strings the +-- last occurrence of a keyword wins, so appending @dbname=…@ overrides any +-- earlier value. +withTestDb :: ByteString -> (ByteString -> IO a) -> IO a +withTestDb adminConninfo action = do + u <- newUnique + let dbName = ByteString.Char8.pack ("lq" <> show (abs (hashUnique u))) + bracket_ + (adminExec adminConninfo ("create database " <> dbName)) + (adminExec adminConninfo ("drop database " <> dbName)) + (action (adminConninfo <> " dbname=" <> dbName)) + +adminExec :: ByteString -> ByteString -> IO () +adminExec conninfo sql = do + conn <- connectdb conninfo :: IO Reference + _ <- exec conn sql + finish conn + +-- | Like 'differential', but for scenarios that exercise connection +-- establishment itself ('Pqi.connectdb' on a broken conninfo, +-- 'Pqi.connectStart', 'Pqi.newNullConnection', ...): instead of an +-- opened connection the scenario receives the conninfo and the candidate's +-- connection type (via 'Proxy'), and manages any connections it opens itself. +differentialConnect :: + forall c a. + (Eq a, Show a, IsConnection c, HasCallStack) => + Proxy c -> + ByteString -> + (forall c'. (IsConnection c', HasCallStack) => Proxy c' -> ByteString -> IO a) -> + Expectation +differentialConnect proxy conninfo scenario = do + candidate <- scenario proxy conninfo + reference <- scenario (Proxy :: Proxy Reference) conninfo + candidate `shouldBe` reference diff --git a/src/library/Pqi/Conformance/Observation.hs b/src/library/Pqi/Conformance/Observation.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Observation.hs @@ -0,0 +1,144 @@ +-- | Plain, comparable snapshots of a connection or result. +-- +-- The candidate adapter and the FFI reference produce values of /different/ +-- types (@'Pqi.ResultOf' candidate@ vs @'Pqi.ResultOf' +-- 'Pqi.Ffi.Connection'@), so they cannot be compared directly. Instead we +-- project each into one of these driver-independent records and compare those. +-- +-- Only protocol-derived information is captured: both adapters parse the same +-- wire bytes, so these fields genuinely agree. Per-connection identity values +-- (@backendPID@, @socket@) are structurally incomparable across connections +-- and are omitted. All result fields — including the flat error message text +-- and all structured error fields — are captured in full and compared +-- byte-identically. +module Pqi.Conformance.Observation + ( ResultObservation (..), + FieldObservation (..), + CellObservation (..), + observeResult, + ConnectionObservation (..), + observeConnection, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Prelude + +-- | A snapshot of an entire result: its status, structured error report, +-- shape, per-field metadata, and every cell. +data ResultObservation = ResultObservation + { status :: Lq.ExecStatus, + -- | Every structured field of the error report, keyed by 'Lq.FieldCode'. + -- All of them are carried by the wire error response. + errorFields :: [(Lq.FieldCode, Maybe ByteString)], + -- | The flat formatted error message, byte-identical to libpq's + -- @PQresultErrorMessage@ at DEFAULT verbosity. + errorMessage :: Maybe ByteString, + ntuples :: Int32, + nfields :: Int32, + nparams :: Int32, + paramTypes :: [Word32], + fields :: [FieldObservation], + rows :: [[CellObservation]], + cmdStatus :: Maybe ByteString, + cmdTuples :: Maybe ByteString + } + deriving stock (Eq, Show) + +-- | A snapshot of one result column's metadata. +data FieldObservation = FieldObservation + { name :: Maybe ByteString, + typeOid :: Word32, + modifier :: Int, + size :: Int, + format :: Lq.Format, + tableOid :: Word32, + tableColumn :: Int32 + } + deriving stock (Eq, Show) + +-- | A snapshot of one cell. +data CellObservation = CellObservation + { value :: Maybe ByteString, + isNull :: Bool, + length :: Int + } + deriving stock (Eq, Show) + +-- | Project a result into a 'ResultObservation'. +observeResult :: (IsResult r) => r -> IO ResultObservation +observeResult result = do + status <- Lq.resultStatus result + errorFields <- + traverse + (\code -> (,) code <$> Lq.resultErrorField result code) + [minBound .. maxBound] + errorMessage <- Lq.resultErrorMessage result + ntuples <- Lq.ntuples result + nfields <- Lq.nfields result + nparams <- Lq.nparams result + paramTypes <- traverse (Lq.paramtype result) [0 .. nparams - 1] + fields <- traverse (observeField result) [0 .. nfields - 1] + rows <- traverse (\row -> traverse (observeCell result row) [0 .. nfields - 1]) [0 .. ntuples - 1] + cmdStatus <- Lq.cmdStatus result + cmdTuples <- Lq.cmdTuples result + pure ResultObservation {..} + +observeField :: (IsResult r) => r -> Int32 -> IO FieldObservation +observeField result column = do + name <- Lq.fname result column + typeOid <- Lq.ftype result column + modifier <- Lq.fmod result column + size <- Lq.fsize result column + format <- Lq.fformat result column + tableOid <- Lq.ftable result column + tableColumn <- Lq.ftablecol result column + pure FieldObservation {..} + +observeCell :: (IsResult r) => r -> Int32 -> Int32 -> IO CellObservation +observeCell result row column = do + value <- Lq.getvalue result row column + isNull <- Lq.getisnull result row column + length <- Lq.getlength result row column + pure CellObservation {..} + +-- | A snapshot of the comparable portion of a connection's state. The +-- candidate and the reference open their connections from the same conninfo +-- string, so the conninfo-derived identity accessors agree as well. +data ConnectionObservation = ConnectionObservation + { status :: Lq.ConnStatus, + transactionStatus :: Lq.TransactionStatus, + serverVersion :: Int, + serverVersionParam :: Maybe ByteString, + protocolVersion :: Int, + db :: Maybe ByteString, + user :: Maybe ByteString, + pass :: Maybe ByteString, + host :: Maybe ByteString, + port :: Maybe ByteString, + options :: Maybe ByteString, + connectionNeedsPassword :: Bool, + connectionUsedPassword :: Bool, + isNull :: Bool + } + deriving stock (Eq, Show) + +-- | Project a connection into a 'ConnectionObservation'. +observeConnection :: (IsConnection c) => c -> IO ConnectionObservation +observeConnection connection = do + status <- Lq.status connection + transactionStatus <- Lq.transactionStatus connection + serverVersion <- Lq.serverVersion connection + serverVersionParam <- Lq.parameterStatus connection "server_version" + protocolVersion <- Lq.protocolVersion connection + db <- Lq.db connection + user <- Lq.user connection + pass <- Lq.pass connection + host <- Lq.host connection + port <- Lq.port connection + options <- Lq.options connection + connectionNeedsPassword <- Lq.connectionNeedsPassword connection + connectionUsedPassword <- Lq.connectionUsedPassword connection + let isNull = Lq.isNullConnection connection + pure ConnectionObservation {..} diff --git a/src/library/Pqi/Conformance/Operation/BackendPID.hs b/src/library/Pqi/Conformance/Operation/BackendPID.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/BackendPID.hs @@ -0,0 +1,20 @@ +-- | Coverage for 'Pqi.backendPID': the backend process ID. +-- +-- The PID differs between the candidate's and the reference's backends, so +-- only its positivity is compared. +module Pqi.Conformance.Operation.BackendPID + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "backendPID" do + it "is positive on an open connection" \conninfo -> + differential proxy conninfo \connection -> + (> 0) <$> backendPID connection diff --git a/src/library/Pqi/Conformance/Operation/Cancel.hs b/src/library/Pqi/Conformance/Operation/Cancel.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Cancel.hs @@ -0,0 +1,46 @@ +-- | Coverage for 'Pqi.cancel': requesting cancellation through a handle, +-- both on an idle connection and against a running query (which then fails +-- with SQLSTATE @57014@). +-- +-- The full 'Either' value is compared — not just success\/failure — so that +-- any divergence in error text is caught. +module Pqi.Conformance.Operation.Cancel + ( spec, + ) +where + +import Pqi (IsCancel (..), IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults, execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "cancel" do + it "succeeds on an idle connection" \conninfo -> + differential proxy conninfo \connection -> do + handle <- getCancel connection + for handle cancel + + it "fails a running query with 57014" \conninfo -> + differential proxy conninfo \connection -> do + sent <- sendQuery connection "select pg_sleep(10)" + threadDelay 100000 + handle <- getCancel connection + cancelled <- for handle cancel + results <- drainResults connection + usable <- execScenario "select 1" connection + pure (sent, cancelled, results, usable) + + it "leaves the connection usable after cancelling a short-running query" \conninfo -> + differential proxy conninfo \connection -> do + outcomes <- replicateM 3 do + sent <- sendQuery connection "select pg_sleep(0.1)" + threadDelay 50000 + handle <- getCancel connection + cancelled <- for handle cancel + results <- drainResults connection + usable <- execScenario "select 1" connection + pure (sent, cancelled, results, usable) + pure outcomes diff --git a/src/library/Pqi/Conformance/Operation/CancelCleanup.hs b/src/library/Pqi/Conformance/Operation/CancelCleanup.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/CancelCleanup.hs @@ -0,0 +1,84 @@ +-- | Regression coverage for the stale-cancel bug that corrupts a connection +-- after a pipelined query completes. +-- +-- Root cause: in pqi-native, 'Pqi.getResult' returns 'Nothing' (the pipeline +-- separator) __before__ reading the trailing 'ReadyForQuery' message, leaving +-- @asyncPending = True@. If 'Pqi.cancel' is called while @asyncPending@ is +-- still @True@ — as 'Hasql.Comms.Session.cleanUpAfterInterruption' does after +-- draining results — a cancel request is sent to the server even though the +-- query has already finished. The server receives the signal, sets +-- @QueryCancelPending@, and the __next__ command (e.g. @ABORT@) is cancelled +-- with SQLSTATE @57014@, leaving the connection unusable. +module Pqi.Conformance.Operation.CancelCleanup + ( spec, + ) +where + +import Control.Exception (bracket) +import Pqi (ExecStatus (..), IsCancel (..), IsConnection (..), IsResult (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: forall c. (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "cancel cleanup" do + -- Reproduces the state that hasql's cleanUpAfterInterruption reaches after + -- a timeout fires mid-pipeline: + -- + -- 1. drainResults reads CommandComplete → separator, exits loop. + -- In pqi-native asyncPending is still True here (ReadyForQuery not + -- yet consumed); in libpq the ReadyForQuery has already been + -- processed internally. + -- 2. cancel is called. pqi-native sends a cancel because + -- asyncPending=True; the query has long since finished so this is + -- a stale cancel. + -- 3. drainResults reads the remaining ReadyForQuery. + -- 4. The connection re-enters serial mode. + -- 5. exec runs a follow-up command — it must NOT be cancelled by the + -- stale signal that arrived in step 2. + it "does not corrupt subsequent commands when cancel is called after pipeline results are drained" \conninfo -> + bracket (connectdb conninfo :: IO c) finish \connection -> do + -- Enter pipeline mode and dispatch a fast query. + _ <- enterPipelineMode connection + _ <- sendQueryParams connection "select 1" [] Lq.Text + _ <- pipelineSync connection + + -- Wait for the server to process the query so both messages + -- (CommandComplete + ReadyForQuery) are already in the socket by the + -- time we start reading. + threadDelay 10_000 -- 10 ms + + -- Drain the command result then the pipeline separator (Nothing). + -- After this loop exits, asyncPending=True in pqi-native because + -- ReadyForQuery has not been read yet. + let drainAll = do + mr <- getResult connection + case mr of + Nothing -> pure () + Just _ -> drainAll + drainAll + + -- Send cancel. Because asyncPending=True in pqi-native, a cancel + -- request is dispatched to the server despite the query being done. + handle <- getCancel connection + for_ handle cancel + + -- Give the stale cancel enough time to reach the server and set + -- QueryCancelPending before the next command arrives. + threadDelay 10_000 -- 10 ms + + -- Read the ReadyForQuery that was still pending. + drainAll + + -- Exit pipeline mode (sends an implicit Sync in the reference impl). + _ <- exitPipelineMode connection + + -- A follow-up command must succeed; 57014 here means the stale cancel + -- corrupted the connection. + mResult <- exec connection "select 1" + case mResult of + Nothing -> expectationFailure "exec returned no result after pipeline cleanup" + Just (result :: ResultOf c) -> do + status <- resultStatus result + status `shouldBe` TuplesOk diff --git a/src/library/Pqi/Conformance/Operation/ClientEncoding.hs b/src/library/Pqi/Conformance/Operation/ClientEncoding.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ClientEncoding.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.clientEncoding': reporting the current client +-- encoding, which tracks 'Pqi.setClientEncoding' and governs how result +-- cells are re-encoded. +module Pqi.Conformance.Operation.ClientEncoding + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "clientEncoding" do + it "round-trips and governs result re-encoding" \conninfo -> + differential proxy conninfo \connection -> do + initial <- clientEncoding connection + setOk <- setClientEncoding connection "LATIN1" + switched <- clientEncoding connection + reported <- parameterStatus connection "client_encoding" + latinCell <- execScenario "select chr(233) as e" connection + restoreOk <- setClientEncoding connection "UTF8" + utfCell <- execScenario "select chr(233) as e" connection + pure (initial, setOk, switched, reported, latinCell, restoreOk, utfCell) diff --git a/src/library/Pqi/Conformance/Operation/CmdStatus.hs b/src/library/Pqi/Conformance/Operation/CmdStatus.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/CmdStatus.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.cmdStatus': the command status tag (e.g. +-- @\"INSERT 0 2\"@) for each kind of command. +module Pqi.Conformance.Operation.CmdStatus + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "cmdStatus" do + it "reports the command tag for each command" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "create temporary table conformance_cmd_status (id int4, label text)" + let tagOf sql = exec connection sql >>= traverse cmdStatus + insert <- tagOf "insert into conformance_cmd_status values (1, 'a'), (2, 'b')" + update <- tagOf "update conformance_cmd_status set label = 'c' where id = 1" + delete <- tagOf "delete from conformance_cmd_status where id = 2" + select <- tagOf "select * from conformance_cmd_status" + pure (insert, update, delete, select) diff --git a/src/library/Pqi/Conformance/Operation/CmdTuples.hs b/src/library/Pqi/Conformance/Operation/CmdTuples.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/CmdTuples.hs @@ -0,0 +1,25 @@ +-- | Coverage for 'Pqi.cmdTuples': the affected-row count (as text) for +-- each kind of command. +module Pqi.Conformance.Operation.CmdTuples + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "cmdTuples" do + it "reports the affected-row count for each command" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "create temporary table conformance_cmd_tuples (id int4, label text)" + let countOf sql = exec connection sql >>= traverse cmdTuples + insert <- countOf "insert into conformance_cmd_tuples values (1, 'a'), (2, 'b')" + update <- countOf "update conformance_cmd_tuples set label = 'c' where id = 1" + delete <- countOf "delete from conformance_cmd_tuples where id = 2" + select <- countOf "select * from conformance_cmd_tuples" + ddl <- countOf "create temporary table conformance_cmd_tuples_2 (id int4)" + pure (insert, update, delete, select, ddl) diff --git a/src/library/Pqi/Conformance/Operation/ConnectPoll.hs b/src/library/Pqi/Conformance/Operation/ConnectPoll.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ConnectPoll.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.connectPoll': driving an asynchronous connection +-- attempt forward until it reports a terminal polling status. +module Pqi.Conformance.Operation.ConnectPoll + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (pollUntilDone) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "connectPoll" do + it "reaches a terminal polling status and a ready connection" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy c) conninfo' -> do + connection <- connectStart conninfo' :: IO c + terminal <- pollUntilDone (connectPoll connection) + connStatus <- status connection + finish connection + pure (terminal, connStatus) diff --git a/src/library/Pqi/Conformance/Operation/ConnectStart.hs b/src/library/Pqi/Conformance/Operation/ConnectStart.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ConnectStart.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.connectStart': beginning an asynchronous connection +-- attempt that is then driven to readiness with 'Pqi.connectPoll'. +module Pqi.Conformance.Operation.ConnectStart + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (pollUntilDone) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "connectStart" do + it "begins an asynchronous connection that polls to readiness" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy c) conninfo' -> do + connection <- connectStart conninfo' :: IO c + polled <- pollUntilDone (connectPoll connection) + observation <- observeConnection connection + finish connection + pure (polled, observation) diff --git a/src/library/Pqi/Conformance/Operation/Connectdb.hs b/src/library/Pqi/Conformance/Operation/Connectdb.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Connectdb.hs @@ -0,0 +1,95 @@ +-- | Coverage for 'Pqi.connectdb': a blocking connection from a conninfo +-- string, including the rejected-conninfo error paths and SCRAM-SHA-256 +-- authentication. +module Pqi.Conformance.Operation.Connectdb + ( spec, + ) +where + +import Control.Exception (bracket) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Char8 as ByteString.Char8 +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Pqi.Conformance.Reference (Reference) +import Test.Hspec +import qualified TestcontainersPostgresql as TcPg + +spec :: forall c. (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = do + describe "connectdb" do + it "opens a usable connection" \conninfo -> + differential proxy conninfo observeConnection + + it "accepts a URI-format conninfo" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy d) conninfo' -> do + connection <- connectdb (kvToUri conninfo') :: IO d + s <- status connection + finish connection + pure s + + it "rejects an unknown database" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy d) conninfo' -> do + connection <- connectdb (conninfo' <> " dbname=pqi_no_such_db") :: IO d + observation <- status connection + nullness <- pure (isNullConnection connection) + finish connection + pure (observation, nullness) + + it "rejects an unknown user" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy d) conninfo' -> do + connection <- connectdb (conninfo' <> " user=pqi_no_such_user") :: IO d + observation <- status connection + finish connection + pure observation + + describe "SCRAM-SHA-256 authentication" do + it "the candidate authenticates and queries like the FFI reference" \_ -> + let scramConfig = + TcPg.Config + { TcPg.tagName = "postgres:17", + TcPg.forwardLogs = False, + TcPg.auth = TcPg.CredentialsAuth "scram" "secret" + } + + scramScenario :: forall c. (IsConnection c) => c -> IO (Maybe ResultObservation) + scramScenario connection = exec connection "select 1 as scram_works" >>= traverse observeResult + in TcPg.run scramConfig \(host, port) -> do + let conninfo = + ByteString.Char8.pack + ( "host=" + <> Text.unpack host + <> " port=" + <> show port + <> " user=scram password=secret dbname=scram" + ) + native <- bracket (connectdb conninfo) finish (scramScenario @c) + reference <- bracket (connectdb conninfo) finish (scramScenario @Reference) + native `shouldBe` reference + +-- | Convert a @key=value@ conninfo to a @postgresql://@ URI, for testing +-- that adapters accept URI-format connection strings. +kvToUri :: ByteString -> ByteString +kvToUri raw = + "postgresql://" + <> user + <> (if ByteString.null password then "" else ":" <> password) + <> (if ByteString.null user && ByteString.null password then "" else "@") + <> host + <> (if ByteString.null port then "" else ":" <> port) + <> (if ByteString.null dbname then "" else "/" <> dbname) + where + pairs = Map.fromList $ mapMaybe toPair (ByteString.Char8.words raw) + get k = Map.findWithDefault "" k pairs + toPair token = case ByteString.Char8.break (== '=') token of + (k, v) | not (ByteString.null v) -> Just (k, ByteString.drop 1 v) + _ -> Nothing + host = get "host" + port = get "port" + user = get "user" + password = get "password" + dbname = get "dbname" diff --git a/src/library/Pqi/Conformance/Operation/ConnectionNeedsPassword.hs b/src/library/Pqi/Conformance/Operation/ConnectionNeedsPassword.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ConnectionNeedsPassword.hs @@ -0,0 +1,17 @@ +-- | Coverage for 'Pqi.connectionNeedsPassword': whether authentication +-- needed a password that was unavailable (False under trust auth). +module Pqi.Conformance.Operation.ConnectionNeedsPassword + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "connectionNeedsPassword" do + it "reports whether a password was needed" \conninfo -> + differential proxy conninfo connectionNeedsPassword diff --git a/src/library/Pqi/Conformance/Operation/ConnectionUsedPassword.hs b/src/library/Pqi/Conformance/Operation/ConnectionUsedPassword.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ConnectionUsedPassword.hs @@ -0,0 +1,17 @@ +-- | Coverage for 'Pqi.connectionUsedPassword': whether authentication +-- used a password (False under trust auth). +module Pqi.Conformance.Operation.ConnectionUsedPassword + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "connectionUsedPassword" do + it "reports whether a password was used" \conninfo -> + differential proxy conninfo connectionUsedPassword diff --git a/src/library/Pqi/Conformance/Operation/ConsumeInput.hs b/src/library/Pqi/Conformance/Operation/ConsumeInput.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ConsumeInput.hs @@ -0,0 +1,28 @@ +-- | Coverage for 'Pqi.consumeInput': reading server input into the +-- driver's buffer so that 'Pqi.isBusy' can settle before collecting +-- results. +module Pqi.Conformance.Operation.ConsumeInput + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "consumeInput" do + it "drives result collection together with isBusy" \conninfo -> + differential proxy conninfo \connection -> do + sent <- sendQuery connection "select 42" + let settle (0 :: Int) = pure False + settle n = do + consumed <- consumeInput connection + busy <- isBusy connection + if busy then threadDelay 1000 >> settle (n - 1) else pure consumed + consumed <- settle 10000 + results <- drainResults connection + pure (sent, consumed, results) diff --git a/src/library/Pqi/Conformance/Operation/Db.hs b/src/library/Pqi/Conformance/Operation/Db.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Db.hs @@ -0,0 +1,16 @@ +-- | Coverage for 'Pqi.db': the database name of the connection. +module Pqi.Conformance.Operation.Db + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "db" do + it "reports the database name from the conninfo" \conninfo -> + differential proxy conninfo db diff --git a/src/library/Pqi/Conformance/Operation/DescribePortal.hs b/src/library/Pqi/Conformance/Operation/DescribePortal.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/DescribePortal.hs @@ -0,0 +1,28 @@ +-- | Coverage for 'Pqi.describePortal': describing a declared cursor's +-- portal and the unknown-portal error path. +module Pqi.Conformance.Operation.DescribePortal + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "describePortal" do + it "describes a declared cursor" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "begin" + _ <- + exec + connection + "declare conformance_cursor cursor for select 1 :: int4 as n, 'x' :: text as t" + describePortal connection "conformance_cursor" >>= traverse observeResult + + it "rejects an unknown portal" \conninfo -> + differential proxy conninfo \connection -> + describePortal connection "conformance_no_portal" >>= traverse observeResult diff --git a/src/library/Pqi/Conformance/Operation/DescribePrepared.hs b/src/library/Pqi/Conformance/Operation/DescribePrepared.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/DescribePrepared.hs @@ -0,0 +1,31 @@ +-- | Coverage for 'Pqi.describePrepared': reporting a prepared statement's +-- parameter types, including explicitly typed parameters and the +-- unknown-statement error path. +module Pqi.Conformance.Operation.DescribePrepared + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (int8Oid) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "describePrepared" do + it "reports parameter types" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_desc" "select $1 :: int4, $2 :: text" Nothing + describePrepared connection "conformance_desc" >>= traverse observeResult + + it "reports explicit parameter types" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_typed" "select $1" (Just [int8Oid]) + describePrepared connection "conformance_typed" >>= traverse observeResult + + it "rejects an unknown statement" \conninfo -> + differential proxy conninfo \connection -> + describePrepared connection "conformance_missing" >>= traverse observeResult diff --git a/src/library/Pqi/Conformance/Operation/DisableNoticeReporting.hs b/src/library/Pqi/Conformance/Operation/DisableNoticeReporting.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/DisableNoticeReporting.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.disableNoticeReporting': turning off notice +-- accumulation again so subsequently raised notices are not retained. +module Pqi.Conformance.Operation.DisableNoticeReporting + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "disableNoticeReporting" do + it "stops retaining notices once disabled" \conninfo -> + differential proxy conninfo \connection -> do + enableNoticeReporting connection + whileEnabled <- raiseNoticeAndCollect connection + disableNoticeReporting connection + whileDisabled <- raiseNoticeAndCollect connection + pure (whileEnabled, whileDisabled) + +raiseNoticeAndCollect :: (IsConnection c) => c -> IO Bool +raiseNoticeAndCollect connection = do + _ <- exec connection "do $$ begin raise notice 'conformance notice'; end $$" + isJust <$> getNotice connection diff --git a/src/library/Pqi/Conformance/Operation/EnableNoticeReporting.hs b/src/library/Pqi/Conformance/Operation/EnableNoticeReporting.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/EnableNoticeReporting.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.enableNoticeReporting': turning on notice +-- accumulation so that a raised notice becomes retrievable via +-- 'Pqi.getNotice'. +module Pqi.Conformance.Operation.EnableNoticeReporting + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "enableNoticeReporting" do + it "makes a raised notice retrievable" \conninfo -> + differential proxy conninfo \connection -> do + beforeEnable <- raiseNoticeAndCollect connection + enableNoticeReporting connection + afterEnable <- raiseNoticeAndCollect connection + pure (beforeEnable, afterEnable) + +raiseNoticeAndCollect :: (IsConnection c) => c -> IO Bool +raiseNoticeAndCollect connection = do + _ <- exec connection "do $$ begin raise notice 'conformance notice'; end $$" + isJust <$> getNotice connection diff --git a/src/library/Pqi/Conformance/Operation/EnterPipelineMode.hs b/src/library/Pqi/Conformance/Operation/EnterPipelineMode.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/EnterPipelineMode.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.enterPipelineMode': switching a connection into +-- pipeline mode (idempotently). +module Pqi.Conformance.Operation.EnterPipelineMode + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "enterPipelineMode" do + it "enters pipeline mode and is idempotent" \conninfo -> + differential proxy conninfo \connection -> do + before <- pipelineStatus connection + entered <- enterPipelineMode connection + enteredAgain <- enterPipelineMode connection + while <- pipelineStatus connection + _ <- exitPipelineMode connection + pure (before, entered, enteredAgain, while) diff --git a/src/library/Pqi/Conformance/Operation/ErrorMessage.hs b/src/library/Pqi/Conformance/Operation/ErrorMessage.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ErrorMessage.hs @@ -0,0 +1,62 @@ +-- | Coverage for 'Pqi.errorMessage': the connection-level error string. +-- +-- The goal is byte-identical output to libpq's @PQerrorMessage@ in all +-- documented scenarios. Error strings are compared in full — not just for +-- presence — so formatting bugs are caught. Scenarios are chosen to avoid +-- statement-position fields (@'P'@), which depend on the client-stored query +-- text and cannot be reproduced from wire fields alone. +-- +-- The one structurally incomparable value is the null-connection sentinel +-- @\"connection pointer is NULL\\n\"@: it is hardcoded in libpq rather than +-- derived from a wire response, but both adapters must return exactly that +-- string. +module Pqi.Conformance.Operation.ErrorMessage + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "errorMessage" do + it "is empty on a healthy connection" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "select 1" + errorMessage connection + + it "is populated after a failed exec and cleared by a subsequent success" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "do $$ begin raise exception 'conformance error'; end $$" + afterFail <- errorMessage connection + _ <- exec connection "select 1" + afterSuccess <- errorMessage connection + pure (afterFail, afterSuccess) + + it "is populated after a failed getResult and cleared by a subsequent success" \conninfo -> + differential proxy conninfo \connection -> do + _ <- sendQuery connection "do $$ begin raise exception 'conformance error'; end $$" + _ <- drainResults connection + afterFail <- errorMessage connection + _ <- sendQuery connection "select 1" + _ <- drainResults connection + afterSuccess <- errorMessage connection + pure (afterFail, afterSuccess) + + it "is populated after a connection failure" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy c) conninfo' -> do + conn <- connectdb (conninfo' <> " user=pqi_no_such_user") :: IO c + msg <- errorMessage conn + finish conn + pure msg + + it "is the null-connection sentinel on a null connection" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy c) _ -> do + conn <- newNullConnection :: IO c + msg <- errorMessage conn + finish conn + pure msg diff --git a/src/library/Pqi/Conformance/Operation/EscapeByteaConn.hs b/src/library/Pqi/Conformance/Operation/EscapeByteaConn.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/EscapeByteaConn.hs @@ -0,0 +1,26 @@ +-- | Coverage for 'Pqi.escapeByteaConn': escaping binary data for a +-- @bytea@ literal across the full byte range. +module Pqi.Conformance.Operation.EscapeByteaConn + ( spec, + ) +where + +import qualified Data.ByteString as ByteString +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "escapeByteaConn" do + it "escapes a range of binary inputs" \conninfo -> + differential proxy conninfo \connection -> + traverse (escapeByteaConn connection) byteaCases + where + byteaCases = + [ "", + "plain", + "\NUL\1\2\3", + ByteString.pack [0 .. 255] + ] diff --git a/src/library/Pqi/Conformance/Operation/EscapeIdentifier.hs b/src/library/Pqi/Conformance/Operation/EscapeIdentifier.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/EscapeIdentifier.hs @@ -0,0 +1,34 @@ +-- | Coverage for 'Pqi.escapeIdentifier': escaping SQL identifiers +-- (including the surrounding quotes) and a round-trip through a query. +module Pqi.Conformance.Operation.EscapeIdentifier + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "escapeIdentifier" do + it "escapes a range of identifiers" \conninfo -> + differential proxy conninfo \connection -> + traverse (escapeIdentifier connection) identifierCases + + it "produces identifiers that round-trip through a query" \conninfo -> + differential proxy conninfo \connection -> do + escaped <- escapeIdentifier connection "Wéird \"column\" name" + for escaped \identifier -> + execScenario ("select 1 as " <> identifier) connection + where + identifierCases = + [ "plain", + "MixedCase", + "with space", + "with\"quote", + "héllo", + "select" + ] diff --git a/src/library/Pqi/Conformance/Operation/EscapeStringConn.hs b/src/library/Pqi/Conformance/Operation/EscapeStringConn.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/EscapeStringConn.hs @@ -0,0 +1,39 @@ +-- | Coverage for 'Pqi.escapeStringConn': escaping strings for SQL +-- literals, the invalid-encoding error path, and a round-trip through a query. +module Pqi.Conformance.Operation.EscapeStringConn + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "escapeStringConn" do + it "escapes a range of strings" \conninfo -> + differential proxy conninfo \connection -> + traverse (escapeStringConn connection) stringCases + + it "rejects invalid encoding" \conninfo -> + differential proxy conninfo \connection -> + escapeStringConn connection "\255\254" + + it "produces literals that round-trip through a query" \conninfo -> + differential proxy conninfo \connection -> do + escaped <- escapeStringConn connection "it's \\ tricky\nstuff" + for escaped \literal -> + execScenario ("select '" <> literal <> "' :: text") connection + where + stringCases = + [ "", + "plain", + "it's", + "back\\slash", + "newline\nand\ttab", + "héllo🐘", + "double''single" + ] diff --git a/src/library/Pqi/Conformance/Operation/Exec.hs b/src/library/Pqi/Conformance/Operation/Exec.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Exec.hs @@ -0,0 +1,36 @@ +-- | Coverage for 'Pqi.exec': the simple-query protocol over a range of +-- result shapes, command tags, and degenerate inputs. +module Pqi.Conformance.Operation.Exec + ( spec, + ) +where + +import Pqi (IsConnection) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "exec" do + let forCase title sql = + it title \conninfo -> differential proxy conninfo (execScenario sql) + forCase "select literal" "select 1" + forCase "multi-row, multi-column" "select i, i * 2 from generate_series (1, 3) as i" + forCase "nulls and text" "select null :: int4, 'hello' :: text, true" + forCase "no rows" "select 1 where false" + forCase "zero columns" "select" + forCase "empty query" "" + forCase "semicolon only" ";" + forCase "comment only" "-- nothing to see here" + forCase "whitespace only" " " + forCase "multiple statements take the last result" "select 1; select 2, 3" + forCase "non-ASCII text" "select 'héllo🐘' as greeting" + forCase "bytea hex output" "select '\\xdeadbeef' :: bytea" + forCase "large value" "select repeat('x', 100000)" + forCase "many rows" "select i from generate_series (1, 1000) as i" + forCase "show command" "show server_version" + forCase "set command" "set application_name to 'conformance-exec'" + forCase "DDL command tag" "create temporary table conformance_exec (id int4)" + forCase "DDL with a notice" "drop table if exists pqi_conformance_absent" diff --git a/src/library/Pqi/Conformance/Operation/ExecParams.hs b/src/library/Pqi/Conformance/Operation/ExecParams.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ExecParams.hs @@ -0,0 +1,85 @@ +-- | Coverage for 'Pqi.execParams': the extended query protocol over +-- parameter formats, result formats, inferred types, nulls, and its error +-- paths. +module Pqi.Conformance.Operation.ExecParams + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "execParams" do + it "text result format" \conninfo -> + differential proxy conninfo (paramsScenario Lq.Text) + it "binary result format" \conninfo -> + differential proxy conninfo (paramsScenario Lq.Binary) + it "null parameter" \conninfo -> + differential proxy conninfo (observed "select $1 :: int4 as maybe_value" [Nothing] Lq.Text) + it "no parameters" \conninfo -> + differential proxy conninfo (observed "select 'none' :: text" [] Lq.Text) + it "binary parameter" \conninfo -> + differential proxy conninfo + $ observed "select $1 :: int4 * 2" [Just (int4Oid, "\NUL\NUL\NUL*", Lq.Binary)] Lq.Text + it "binary bytea round-trip" \conninfo -> + differential proxy conninfo + $ observed "select $1 :: bytea" [Just (byteaOid, "\NUL\1\2\255", Lq.Binary)] Lq.Binary + it "inferred parameter type" \conninfo -> + differential proxy conninfo + $ observed "select $1 :: int4 + 1" [Just (0, "41", Lq.Text)] Lq.Text + it "empty string is not null" \conninfo -> + differential proxy conninfo + $ observed "select $1 :: text, length ($1 :: text)" [Just (textOid, "", Lq.Text)] Lq.Text + it "many mixed parameters" \conninfo -> + differential proxy conninfo + $ observed + "select $1 :: int8, $2 :: float8, $3 :: bool, $4 :: text, $5 :: int4, $6 :: text" + [ Just (int8Oid, "9000000000000000000", Lq.Text), + Just (float8Oid, "2.5", Lq.Text), + Just (boolOid, "t", Lq.Text), + Nothing, + Just (int4Oid, "-1", Lq.Text), + Just (textOid, "héllo", Lq.Text) + ] + Lq.Text + it "DML with parameters" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "create temporary table conformance_exec_params (id int4)" + insert <- + observed + "insert into conformance_exec_params values ($1), ($2)" + [Just (int4Oid, "1", Lq.Text), Just (int4Oid, "2", Lq.Text)] + Lq.Text + connection + check <- + observed + "select count(*) from conformance_exec_params where id <= $1" + [Just (int4Oid, "2", Lq.Text)] + Lq.Text + connection + pure (insert, check) + it "too few parameters" \conninfo -> + differential proxy conninfo + $ observed "select $1 :: int4 + $2 :: int4" [Just (int4Oid, "1", Lq.Text)] Lq.Text + it "malformed parameter value" \conninfo -> + differential proxy conninfo + $ observed "select $1 :: int4" [Just (int4Oid, "not-a-number", Lq.Text)] Lq.Text + it "multiple statements are rejected" \conninfo -> + differential proxy conninfo (observed "select 1; select 2" [] Lq.Text) + +paramsScenario :: (IsConnection c) => Lq.Format -> c -> IO (Maybe ResultObservation) +paramsScenario resultFormat = + observed + "select $1 :: int4 + $2 :: int4 as sum, $3 :: text as label" + [ Just (int4Oid, "40", Lq.Text), + Just (int4Oid, "2", Lq.Text), + Just (textOid, "hi", Lq.Text) + ] + resultFormat diff --git a/src/library/Pqi/Conformance/Operation/ExecPrepared.hs b/src/library/Pqi/Conformance/Operation/ExecPrepared.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ExecPrepared.hs @@ -0,0 +1,46 @@ +-- | Coverage for 'Pqi.execPrepared': executing a prepared statement over +-- named and unnamed statements, parameter formats, and the unknown-statement +-- error path. +module Pqi.Conformance.Operation.ExecPrepared + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "execPrepared" do + it "executes a prepared statement" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_stmt" "select $1 :: text as a, $2 :: int4 as b" Nothing + execPrepared connection "conformance_stmt" [Just ("hello", Lq.Text), Just ("7", Lq.Text)] Lq.Text + >>= traverse observeResult + + it "executes the unnamed prepared statement" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "" "select $1 :: int4 + 1" Nothing + execPrepared connection "" [Just ("41", Lq.Text)] Lq.Text + >>= traverse observeResult + + it "executes a zero-parameter statement" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_no_params" "select 42" Nothing + execPrepared connection "conformance_no_params" [] Lq.Text + >>= traverse observeResult + + it "binds null and binary parameters with a binary result" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_binary" "select $1 :: text, $2 :: bytea" Nothing + execPrepared connection "conformance_binary" [Nothing, Just ("\NUL\1\255", Lq.Binary)] Lq.Binary + >>= traverse observeResult + + it "rejects an unknown statement" \conninfo -> + differential proxy conninfo \connection -> + execPrepared connection "conformance_missing" [] Lq.Text + >>= traverse observeResult diff --git a/src/library/Pqi/Conformance/Operation/ExitPipelineMode.hs b/src/library/Pqi/Conformance/Operation/ExitPipelineMode.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ExitPipelineMode.hs @@ -0,0 +1,117 @@ +-- | Coverage for 'Pqi.exitPipelineMode': leaving pipeline mode, which +-- fails while work is still pending and succeeds once the pipeline is drained. +module Pqi.Conformance.Operation.ExitPipelineMode + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults, execScenario, float8Oid, takeCommandResults, takeResult) +import System.Timeout (timeout) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "exitPipelineMode" do + it "returns the connection to its non-pipeline status" \conninfo -> + differential proxy conninfo \connection -> do + _ <- enterPipelineMode connection + exited <- exitPipelineMode connection + after <- pipelineStatus connection + pure (exited, after) + + it "fails with work pending and succeeds once drained" \conninfo -> + differential proxy conninfo \connection -> do + entered <- enterPipelineMode connection + sent <- sendQueryParams connection "select 1" [] Lq.Text + prematureExit <- exitPipelineMode connection + synced <- pipelineSync connection + results <- takeCommandResults connection + syncResult <- takeResult connection + exited <- exitPipelineMode connection + pure (entered, sent, prematureExit, synced, results, syncResult, exited) + + -- Reproduces the cleanup sequence that hasql's cleanUpAfterInterruption + + -- leavePipeline performs after a timeout mid-pipeline. Two prepared + -- statements are used so that pendingParses is tracked (matching the + -- real-world scenario). The slow statement is cancelled before its result + -- is consumed, then the connection is restored via the exact drain/sync + -- sequence that hasql uses. + it "recovers after mid-pipeline cancel (mirrors cleanUpAfterInterruption)" \conninfo -> + differential proxy conninfo \connection -> do + _ <- enterPipelineMode connection + _ <- sendPrepare connection "s1" "select 1" Nothing + _ <- sendQueryPrepared connection "s1" [] Lq.Text + _ <- sendPrepare connection "s2" "select pg_sleep($1)" (Just [float8Oid]) + _ <- sendQueryPrepared connection "s2" [Just ("0.5", Lq.Text)] Lq.Text + _ <- pipelineSync connection + _ <- sendFlushRequest connection + -- Consume what toPipelineIO would have read before the timeout: + -- parse1 result + separator, exec1 result + separator, parse2 result + separator. + _ <- takeCommandResults connection + _ <- takeCommandResults connection + _ <- takeCommandResults connection + -- exec2 (pg_sleep) is still running; cancel it to simulate the + -- timeout-triggered cancel in cleanUpAfterInterruption. + mHandle <- getCancel connection + _ <- for mHandle Lq.cancel + -- cleanUpAfterInterruption: drain1, then drain2 (after cancel) + _ <- drainResults connection + _ <- drainResults connection + -- leavePipeline: new Sync, drain, Flush, drain + _ <- pipelineSync connection + _ <- drainResults connection + _ <- sendFlushRequest connection + _ <- drainResults connection + exited <- exitPipelineMode connection + pure exited + + -- Reproduces the failure seen in hasql's "Leaves the connection usable + -- after timeout in pipeline" test. A fast prepared statement is followed + -- by a slow one; the whole read phase is wrapped in a short timeout so the + -- slow statement is interrupted. The exact cleanup sequence hasql uses is + -- then applied, and the connection must be left out of pipeline mode and + -- usable. + -- + -- The reference (libpq) completes the blocked read before the async + -- exception is delivered, so the session has already exited pipeline mode + -- when cleanup starts. The pqi-native adapter is interrupted mid-read and + -- currently fails to leave pipeline mode, which is the bug this scenario + -- captures. + it "recovers after timeout interrupts mid-pipeline read" \conninfo -> + differential proxy conninfo \connection -> do + _ <- enterPipelineMode connection + _ <- sendPrepare connection "s1" "select $1::int" Nothing + _ <- sendQueryPrepared connection "s1" [Just ("42", Lq.Text)] Lq.Text + _ <- sendPrepare connection "s2" "select pg_sleep($1)" (Just [float8Oid]) + _ <- sendQueryPrepared connection "s2" [Just ("0.1", Lq.Text)] Lq.Text + _ <- pipelineSync connection + -- Interrupt the read just like hasql's Connection.use + timeout does. + _ <- timeout 50000 (drainResults connection) + -- cleanUpAfterInterruption + _ <- drainResults connection + mHandle <- getCancel connection + _ <- for mHandle Lq.cancel + _ <- drainResults connection + -- leavePipeline (including the retry that hasql performs) + pipelineStatusBefore <- pipelineStatus connection + exited <- + if pipelineStatusBefore == Lq.PipelineOn + then do + _ <- pipelineSync connection + _ <- drainResults connection + _ <- sendFlushRequest connection + _ <- drainResults connection + ok <- exitPipelineMode connection + if ok + then pure True + else do + _ <- drainResults connection + exitPipelineMode connection + else pure True + afterStatus <- pipelineStatus connection + usable <- execScenario "select 99" connection + pure (exited, afterStatus, usable) diff --git a/src/library/Pqi/Conformance/Operation/Fformat.hs b/src/library/Pqi/Conformance/Operation/Fformat.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Fformat.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.fformat': the format (text or binary) of each +-- column, which follows the result format requested of +-- 'Pqi.execParams'. +module Pqi.Conformance.Operation.Fformat + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "fformat" do + it "follows the requested result format" \conninfo -> + differential proxy conninfo \connection -> do + let formatsOf fmt = + execParams connection "select 1 :: int4, 'x' :: text" [] fmt + >>= traverse \r -> do + n <- nfields r + traverse (fformat r) [0 .. n - 1] + textFormats <- formatsOf Lq.Text + binaryFormats <- formatsOf Lq.Binary + pure (textFormats, binaryFormats) diff --git a/src/library/Pqi/Conformance/Operation/Finish.hs b/src/library/Pqi/Conformance/Operation/Finish.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Finish.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.finish': closing a connection releases it without +-- error, whether the connection was open or the null sentinel. +module Pqi.Conformance.Operation.Finish + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "finish" do + it "closes an open connection cleanly" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy c) conninfo' -> do + connection <- connectdb conninfo' :: IO c + before <- status connection + finish connection + pure before + + it "closes the null sentinel cleanly" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy c) _ -> do + connection <- newNullConnection :: IO c + finish connection + pure () diff --git a/src/library/Pqi/Conformance/Operation/Flush.hs b/src/library/Pqi/Conformance/Operation/Flush.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Flush.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.flush': flushing queued output to the server in +-- non-blocking mode until it reports completion. +module Pqi.Conformance.Operation.Flush + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults, flushUntilDone) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "flush" do + it "flushes queued output to completion in non-blocking mode" \conninfo -> + differential proxy conninfo \connection -> do + setOk <- setnonblocking connection True + sent <- sendQuery connection "select 1" + flushed <- flushUntilDone (flush connection) + results <- drainResults connection + restoreOk <- setnonblocking connection False + pure (setOk, sent, flushed, results, restoreOk) diff --git a/src/library/Pqi/Conformance/Operation/Fmod.hs b/src/library/Pqi/Conformance/Operation/Fmod.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Fmod.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.fmod': the type modifier of each column (e.g. the +-- precision\/scale of a @numeric@), including an out-of-range index. +module Pqi.Conformance.Operation.Fmod + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "fmod" do + it "reports type modifiers and degrades out of range" \conninfo -> + differential proxy conninfo \connection -> do + result <- + exec connection "select 1.5 :: numeric(10,2), 'pad' :: char(5), 'x' :: varchar(3), true, 1 :: int4" + for result \r -> do + n <- nfields r + modifiers <- traverse (fmod r) [0 .. n - 1] + outOfRange <- fmod r 9 + pure (modifiers, outOfRange) diff --git a/src/library/Pqi/Conformance/Operation/Fname.hs b/src/library/Pqi/Conformance/Operation/Fname.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Fname.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.fname': column names by index, including an +-- out-of-range index. +module Pqi.Conformance.Operation.Fname + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "fname" do + it "names columns and degrades out of range" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 1 as foo, 2 as bar" + for result \r -> do + n <- nfields r + names <- traverse (fname r) [0 .. n - 1] + outOfRange <- fname r 5 + pure (names, outOfRange) diff --git a/src/library/Pqi/Conformance/Operation/Fnumber.hs b/src/library/Pqi/Conformance/Operation/Fnumber.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Fnumber.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.fnumber': resolving a column name to an index, +-- folding the argument the way @PQfnumber@ does (ASCII case folding outside +-- double quotes, quoted runs verbatim). +module Pqi.Conformance.Operation.Fnumber + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "fnumber" do + it "resolves names like an identifier" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 1 as foo, 2 as \"Bar\"" + for result \r -> + traverse + (fnumber r) + ["foo", "FOO", "Foo", "Bar", "bar", "\"Bar\"", "\"foo\"", "missing"] diff --git a/src/library/Pqi/Conformance/Operation/Fsize.hs b/src/library/Pqi/Conformance/Operation/Fsize.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Fsize.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.fsize': the server-side storage size of each +-- column's type (negative for variable size), including an out-of-range index. +module Pqi.Conformance.Operation.Fsize + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "fsize" do + it "reports type sizes and degrades out of range" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 1 :: int2, 1 :: int4, 1 :: int8, 'x' :: text, true" + for result \r -> do + n <- nfields r + sizes <- traverse (fsize r) [0 .. n - 1] + outOfRange <- fsize r 9 + pure (sizes, outOfRange) diff --git a/src/library/Pqi/Conformance/Operation/Ftable.hs b/src/library/Pqi/Conformance/Operation/Ftable.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Ftable.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.ftable': the source-table OID of each column. +-- +-- A shared @pg_catalog@ table is selected so the OID is identical across the +-- candidate's and the reference's connections (a temporary table's OID would +-- differ per connection). +module Pqi.Conformance.Operation.Ftable + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "ftable" do + it "reports the source-table OID, or none for a computed column" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select relname, relkind, 1 as computed from pg_catalog.pg_class where false" + for result \r -> do + n <- nfields r + traverse (ftable r) [0 .. n - 1] diff --git a/src/library/Pqi/Conformance/Operation/Ftablecol.hs b/src/library/Pqi/Conformance/Operation/Ftablecol.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Ftablecol.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.ftablecol': the source-column number of each result +-- column. +-- +-- A shared @pg_catalog@ table is selected so the provenance is identical across +-- the candidate's and the reference's connections. +module Pqi.Conformance.Operation.Ftablecol + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "ftablecol" do + it "reports the source-column number, or zero for a computed column" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select relname, relkind, 1 as computed from pg_catalog.pg_class where false" + for result \r -> do + n <- nfields r + traverse (ftablecol r) [0 .. n - 1] diff --git a/src/library/Pqi/Conformance/Operation/Ftype.hs b/src/library/Pqi/Conformance/Operation/Ftype.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Ftype.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.ftype': the data-type OID of each column, including +-- an out-of-range index. +module Pqi.Conformance.Operation.Ftype + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "ftype" do + it "reports type OIDs and degrades out of range" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 1 :: int4, 'x' :: text, true, 1.5 :: float8, 1 :: int2" + for result \r -> do + n <- nfields r + types <- traverse (ftype r) [0 .. n - 1] + outOfRange <- ftype r 9 + pure (types, outOfRange) diff --git a/src/library/Pqi/Conformance/Operation/GetCancel.hs b/src/library/Pqi/Conformance/Operation/GetCancel.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/GetCancel.hs @@ -0,0 +1,18 @@ +-- | Coverage for 'Pqi.getCancel': obtaining a cancellation handle from a +-- connection. +module Pqi.Conformance.Operation.GetCancel + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "getCancel" do + it "produces a handle for an open connection" \conninfo -> + differential proxy conninfo \connection -> + isJust <$> getCancel connection diff --git a/src/library/Pqi/Conformance/Operation/GetCopyData.hs b/src/library/Pqi/Conformance/Operation/GetCopyData.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/GetCopyData.hs @@ -0,0 +1,29 @@ +-- | Coverage for 'Pqi.getCopyData': receiving rows from a +-- @COPY TO STDOUT@ in text, CSV, and binary formats. +module Pqi.Conformance.Operation.GetCopyData + ( spec, + ) +where + +import Pqi (IsConnection) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (collectCopyOut, drainResults, execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "getCopyData" do + let copyOut sql conninfo = + differential proxy conninfo \connection -> do + started <- execScenario sql connection + rows <- collectCopyOut connection + outcome <- drainResults connection + pure (started, rows, outcome) + it "receives text rows" + $ copyOut "copy (select i, i * 2 from generate_series (1, 3) as i) to stdout" + it "receives CSV rows with a header" + $ copyOut + "copy (select i as n, 'v' || i as v from generate_series (1, 2) as i) to stdout (format csv, header)" + it "receives binary rows" + $ copyOut "copy (select i from generate_series (1, 2) as i) to stdout (format binary)" diff --git a/src/library/Pqi/Conformance/Operation/GetNotice.hs b/src/library/Pqi/Conformance/Operation/GetNotice.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/GetNotice.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.getNotice': retrieving accumulated notices, which +-- are present only while reporting is enabled and drain after retrieval. +-- +-- The notice text is compared byte-identically — both adapters must produce +-- the same formatted string as libpq's notice processor at DEFAULT verbosity. +-- At that verbosity, context (@'W'@ field) is suppressed for NOTICE-level +-- messages, so the formatted string is just @\"NOTICE: \\\n\"@. +module Pqi.Conformance.Operation.GetNotice + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "getNotice" do + it "yields the formatted notice while enabled and then drains" \conninfo -> + differential proxy conninfo \connection -> do + enableNoticeReporting connection + _ <- exec connection "do $$ begin raise notice 'conformance notice'; end $$" + firstNotice <- getNotice connection + afterDrain <- getNotice connection + pure (firstNotice, afterDrain) diff --git a/src/library/Pqi/Conformance/Operation/GetResult.hs b/src/library/Pqi/Conformance/Operation/GetResult.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/GetResult.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.getResult': collecting the results of an +-- asynchronous command one at a time, ending with the 'Nothing' terminator. +module Pqi.Conformance.Operation.GetResult + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (takeResult) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "getResult" do + it "yields each result then a Nothing terminator" \conninfo -> + differential proxy conninfo \connection -> do + _ <- sendQuery connection "select 1 :: int4" + first <- takeResult connection + terminator <- takeResult connection + afterTerminator <- takeResult connection + pure (first, terminator, afterTerminator) diff --git a/src/library/Pqi/Conformance/Operation/Getisnull.hs b/src/library/Pqi/Conformance/Operation/Getisnull.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Getisnull.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.getisnull': whether a cell is SQL @NULL@, +-- distinguishing a null from an empty string. +module Pqi.Conformance.Operation.Getisnull + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "getisnull" do + it "distinguishes null, empty, and non-empty cells" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 'x' :: text, '' :: text, null :: int4" + for result \r -> do + nonEmpty <- getisnull r 0 0 + empty <- getisnull r 0 1 + nullCell <- getisnull r 0 2 + pure (nonEmpty, empty, nullCell) diff --git a/src/library/Pqi/Conformance/Operation/Getlength.hs b/src/library/Pqi/Conformance/Operation/Getlength.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Getlength.hs @@ -0,0 +1,21 @@ +-- | Coverage for 'Pqi.getlength': the byte length of a cell value, +-- including a multibyte value, an empty string, and a null. +module Pqi.Conformance.Operation.Getlength + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "getlength" do + it "reports byte lengths across cell shapes" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 'hello' :: text, 'héllo' :: text, '' :: text, null :: int4" + for result \r -> do + n <- nfields r + traverse (getlength r 0) [0 .. n - 1] diff --git a/src/library/Pqi/Conformance/Operation/Getvalue.hs b/src/library/Pqi/Conformance/Operation/Getvalue.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Getvalue.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.getvalue': the cell value at a position, 'Nothing' +-- for SQL @NULL@, and out-of-range row and column probes. +module Pqi.Conformance.Operation.Getvalue + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "getvalue" do + it "reads cells, nulls, and degrades out of range" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 'hello' :: text, null :: int4" + for result \r -> do + present <- getvalue r 0 0 + nullCell <- getvalue r 0 1 + badRow <- getvalue r 1 0 + badColumn <- getvalue r 0 5 + pure (present, nullCell, badRow, badColumn) diff --git a/src/library/Pqi/Conformance/Operation/GetvalueCopy.hs b/src/library/Pqi/Conformance/Operation/GetvalueCopy.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/GetvalueCopy.hs @@ -0,0 +1,23 @@ +-- | Coverage for @getvalue'@ ('Pqi.getvalue''): a copying cell read whose +-- bytes remain valid after the result is freed. +module Pqi.Conformance.Operation.GetvalueCopy + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "getvalue'" do + it "copies cells that survive freeing the result" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 'copied' :: text, null :: int4" + for result \r -> do + first <- getvalue' r 0 0 + second <- getvalue' r 0 1 + unsafeFreeResult r + pure (first, second) diff --git a/src/library/Pqi/Conformance/Operation/Host.hs b/src/library/Pqi/Conformance/Operation/Host.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Host.hs @@ -0,0 +1,16 @@ +-- | Coverage for 'Pqi.host': the server host name of the connection. +module Pqi.Conformance.Operation.Host + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "host" do + it "reports the host from the conninfo" \conninfo -> + differential proxy conninfo host diff --git a/src/library/Pqi/Conformance/Operation/IsBusy.hs b/src/library/Pqi/Conformance/Operation/IsBusy.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/IsBusy.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.isBusy': reporting whether a 'Pqi.getResult' +-- would block, settling to not-busy once the result has arrived. +module Pqi.Conformance.Operation.IsBusy + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "isBusy" do + it "settles to not-busy after the result arrives" \conninfo -> + differential proxy conninfo \connection -> do + _ <- sendQuery connection "select 42" + let settle (0 :: Int) = isBusy connection + settle n = do + _ <- consumeInput connection + busy <- isBusy connection + if busy then threadDelay 1000 >> settle (n - 1) else pure busy + stillBusy <- settle 10000 + _ <- drainResults connection + pure stillBusy diff --git a/src/library/Pqi/Conformance/Operation/IsNullConnection.hs b/src/library/Pqi/Conformance/Operation/IsNullConnection.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/IsNullConnection.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.isNullConnection': distinguishes the null sentinel +-- from a genuinely open connection. +module Pqi.Conformance.Operation.IsNullConnection + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "isNullConnection" do + it "is True for the null sentinel and False for an open connection" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy c) conninfo' -> do + nullConn <- newNullConnection :: IO c + let nullIsNull = isNullConnection nullConn + finish nullConn + openConn <- connectdb conninfo' :: IO c + let openIsNull = isNullConnection openConn + finish openConn + pure (nullIsNull, openIsNull) diff --git a/src/library/Pqi/Conformance/Operation/Isnonblocking.hs b/src/library/Pqi/Conformance/Operation/Isnonblocking.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Isnonblocking.hs @@ -0,0 +1,21 @@ +-- | Coverage for 'Pqi.isnonblocking': reporting the connection's +-- non-blocking flag, which defaults to off. +module Pqi.Conformance.Operation.Isnonblocking + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "isnonblocking" do + it "is off initially and reflects a change" \conninfo -> + differential proxy conninfo \connection -> do + initially <- isnonblocking connection + _ <- setnonblocking connection True + afterEnable <- isnonblocking connection + pure (initially, afterEnable) diff --git a/src/library/Pqi/Conformance/Operation/LoClose.hs b/src/library/Pqi/Conformance/Operation/LoClose.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoClose.hs @@ -0,0 +1,28 @@ +-- | Coverage for 'Pqi.loClose': closing an open large object, after which +-- reads through the stale descriptor fail. +module Pqi.Conformance.Operation.LoClose + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import System.IO (IOMode (..)) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loClose" do + it "closes the descriptor and invalidates further reads" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + outcome <- for oid \o -> do + fd <- loOpen connection o ReadMode + closed <- for fd \f -> loClose connection f + readAfterClose <- join <$> for fd \f -> loRead connection f 10 + pure (closed, readAfterClose) + traverse_ (loUnlink connection) oid + pure outcome diff --git a/src/library/Pqi/Conformance/Operation/LoCreat.hs b/src/library/Pqi/Conformance/Operation/LoCreat.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoCreat.hs @@ -0,0 +1,25 @@ +-- | Coverage for 'Pqi.loCreat': creating a new large object with a +-- server-assigned OID. +-- +-- The assigned OID differs between the candidate's and the reference's runs, +-- so only its presence is compared. +module Pqi.Conformance.Operation.LoCreat + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loCreat" do + it "creates a large object" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + traverse_ (loUnlink connection) oid + pure (isJust oid) diff --git a/src/library/Pqi/Conformance/Operation/LoCreate.hs b/src/library/Pqi/Conformance/Operation/LoCreate.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoCreate.hs @@ -0,0 +1,30 @@ +-- | Coverage for 'Pqi.loCreate': creating a new large object with an +-- explicitly requested OID. +-- +-- Each run removes the object it creates, so the explicit OID is free for the +-- reference run and can be compared in full. +module Pqi.Conformance.Operation.LoCreate + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loCreate" do + it "creates a large object with an explicit OID" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + -- Best-effort cleanup of leftovers from an earlier crashed run; its + -- outcome legitimately differs between runs, so it is not observed. + _ <- loUnlink connection explicitOid + created <- loCreate connection explicitOid + unlinked <- for created (loUnlink connection) + pure (created, unlinked) + where + explicitOid = 424242 diff --git a/src/library/Pqi/Conformance/Operation/LoExport.hs b/src/library/Pqi/Conformance/Operation/LoExport.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoExport.hs @@ -0,0 +1,37 @@ +-- | Coverage for 'Pqi.loExport': exporting a large object back to a file, +-- round-tripping its bytes. +-- +-- @lo_import@\/@lo_export@ are self-contained and run in autocommit; they need +-- no explicit transaction block. +module Pqi.Conformance.Operation.LoExport + ( spec, + ) +where + +import qualified Data.ByteString as ByteString +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import System.Directory (removeFile) +import System.IO (hClose, openBinaryTempFile) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loExport" do + it "exports an imported object, round-tripping its bytes" \conninfo -> + differential proxy conninfo \connection -> do + (importPath, importHandle) <- openBinaryTempFile "/tmp" "pqi-conformance-export-in" + ByteString.hPut importHandle payload + hClose importHandle + (exportPath, exportHandle) <- openBinaryTempFile "/tmp" "pqi-conformance-export-out" + hClose exportHandle + imported <- loImport connection importPath + exported <- for imported \o -> loExport connection o exportPath + traverse_ (loUnlink connection) imported + roundTripped <- ByteString.readFile exportPath + removeFile importPath + removeFile exportPath + pure (exported, roundTripped == payload) + where + payload = "pqi conformance payload\n" <> ByteString.pack [0 .. 255] diff --git a/src/library/Pqi/Conformance/Operation/LoImport.hs b/src/library/Pqi/Conformance/Operation/LoImport.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoImport.hs @@ -0,0 +1,30 @@ +-- | Coverage for 'Pqi.loImport': importing a file as a new large object. +-- +-- The server-assigned OID differs between runs, so only its presence is +-- compared. @lo_import@ is self-contained and runs in autocommit; it needs no +-- explicit transaction block. +module Pqi.Conformance.Operation.LoImport + ( spec, + ) +where + +import qualified Data.ByteString as ByteString +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import System.Directory (removeFile) +import System.IO (hClose, openBinaryTempFile) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loImport" do + it "imports a file as a large object" \conninfo -> + differential proxy conninfo \connection -> do + (path, handle) <- openBinaryTempFile "/tmp" "pqi-conformance-import" + ByteString.hPut handle "pqi conformance payload" + hClose handle + imported <- loImport connection path + traverse_ (loUnlink connection) imported + removeFile path + pure (isJust imported) diff --git a/src/library/Pqi/Conformance/Operation/LoImportWithOid.hs b/src/library/Pqi/Conformance/Operation/LoImportWithOid.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoImportWithOid.hs @@ -0,0 +1,34 @@ +-- | Coverage for 'Pqi.loImportWithOid': importing a file as a new large +-- object with an explicitly requested OID. +-- +-- Each run removes the object it creates, so the explicit OID is free for the +-- reference run and can be compared in full. @lo_import@ is self-contained and +-- runs in autocommit; it needs no explicit transaction block. +module Pqi.Conformance.Operation.LoImportWithOid + ( spec, + ) +where + +import qualified Data.ByteString as ByteString +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import System.Directory (removeFile) +import System.IO (hClose, openBinaryTempFile) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loImportWithOid" do + it "imports a file as a large object with an explicit OID" \conninfo -> + differential proxy conninfo \connection -> do + (path, handle) <- openBinaryTempFile "/tmp" "pqi-conformance-import-oid" + ByteString.hPut handle "pqi conformance payload" + hClose handle + _ <- loUnlink connection explicitOid + imported <- loImportWithOid connection path explicitOid + unlinked <- for imported (loUnlink connection) + removeFile path + pure (imported, unlinked) + where + explicitOid = 424243 diff --git a/src/library/Pqi/Conformance/Operation/LoOpen.hs b/src/library/Pqi/Conformance/Operation/LoOpen.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoOpen.hs @@ -0,0 +1,30 @@ +-- | Coverage for 'Pqi.loOpen': opening a large object, including the +-- error path for a non-existent object. +module Pqi.Conformance.Operation.LoOpen + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import System.IO (IOMode (..)) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loOpen" do + it "opens an existing object and rejects a missing one" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + opened <- for oid \o -> do + fd <- loOpen connection o ReadWriteMode + traverse_ (loClose connection) fd + pure (isJust fd) + loUnlink' oid connection + missing <- loOpen connection 4242424 ReadMode + pure (opened, isJust missing) + where + loUnlink' oid connection = traverse_ (loUnlink connection) oid diff --git a/src/library/Pqi/Conformance/Operation/LoRead.hs b/src/library/Pqi/Conformance/Operation/LoRead.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoRead.hs @@ -0,0 +1,31 @@ +-- | Coverage for 'Pqi.loRead': reading bytes back from an open large +-- object after seeking to its start. +module Pqi.Conformance.Operation.LoRead + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import System.IO (IOMode (..), SeekMode (..)) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loRead" do + it "reads back what was written" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + outcome <- for oid \o -> do + fd <- loOpen connection o ReadWriteMode + readBytes <- for fd \f -> do + _ <- loWrite connection f "hello, large object" + _ <- loSeek connection f AbsoluteSeek 0 + loRead connection f 5 + traverse_ (loClose connection) fd + pure readBytes + traverse_ (loUnlink connection) oid + pure outcome diff --git a/src/library/Pqi/Conformance/Operation/LoSeek.hs b/src/library/Pqi/Conformance/Operation/LoSeek.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoSeek.hs @@ -0,0 +1,33 @@ +-- | Coverage for 'Pqi.loSeek': repositioning within an open large object +-- with absolute, relative, and from-end seeks. +module Pqi.Conformance.Operation.LoSeek + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import System.IO (IOMode (..), SeekMode (..)) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loSeek" do + it "seeks absolutely, relatively, and from the end" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + outcome <- for oid \o -> do + fd <- loOpen connection o ReadWriteMode + seeks <- for fd \f -> do + _ <- loWrite connection f "hello, large object" + absolute <- loSeek connection f AbsoluteSeek 0 + relative <- loSeek connection f RelativeSeek 2 + fromEnd <- loSeek connection f SeekFromEnd (-6) + pure (absolute, relative, fromEnd) + traverse_ (loClose connection) fd + pure seeks + traverse_ (loUnlink connection) oid + pure outcome diff --git a/src/library/Pqi/Conformance/Operation/LoTell.hs b/src/library/Pqi/Conformance/Operation/LoTell.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoTell.hs @@ -0,0 +1,33 @@ +-- | Coverage for 'Pqi.loTell': reporting the current seek position of an +-- open large object. +module Pqi.Conformance.Operation.LoTell + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import System.IO (IOMode (..), SeekMode (..)) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loTell" do + it "reports the position after a write and a seek" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + outcome <- for oid \o -> do + fd <- loOpen connection o ReadWriteMode + positions <- for fd \f -> do + _ <- loWrite connection f "hello, large object" + afterWrite <- loTell connection f + _ <- loSeek connection f AbsoluteSeek 3 + afterSeek <- loTell connection f + pure (afterWrite, afterSeek) + traverse_ (loClose connection) fd + pure positions + traverse_ (loUnlink connection) oid + pure outcome diff --git a/src/library/Pqi/Conformance/Operation/LoTruncate.hs b/src/library/Pqi/Conformance/Operation/LoTruncate.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoTruncate.hs @@ -0,0 +1,32 @@ +-- | Coverage for 'Pqi.loTruncate': truncating an open large object, after +-- which a seek to the end reports the new size. +module Pqi.Conformance.Operation.LoTruncate + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import System.IO (IOMode (..), SeekMode (..)) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loTruncate" do + it "truncates to a new size" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + outcome <- for oid \o -> do + fd <- loOpen connection o ReadWriteMode + result <- for fd \f -> do + _ <- loWrite connection f "hello, large object" + truncated <- loTruncate connection f 5 + newEnd <- loSeek connection f SeekFromEnd 0 + pure (truncated, newEnd) + traverse_ (loClose connection) fd + pure result + traverse_ (loUnlink connection) oid + pure outcome diff --git a/src/library/Pqi/Conformance/Operation/LoUnlink.hs b/src/library/Pqi/Conformance/Operation/LoUnlink.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoUnlink.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.loUnlink': removing a large object, including the +-- error path for a non-existent object. +module Pqi.Conformance.Operation.LoUnlink + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loUnlink" do + it "removes an existing object and rejects a missing one" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + removed <- for oid (loUnlink connection) + missing <- loUnlink connection 4242424 + pure (removed, missing) diff --git a/src/library/Pqi/Conformance/Operation/LoWrite.hs b/src/library/Pqi/Conformance/Operation/LoWrite.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/LoWrite.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.loWrite': writing bytes to an open large object. +module Pqi.Conformance.Operation.LoWrite + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (inTransaction) +import System.IO (IOMode (..)) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "loWrite" do + it "reports the number of bytes written" \conninfo -> + differential proxy conninfo \connection -> + inTransaction connection do + oid <- loCreat connection + outcome <- for oid \o -> do + fd <- loOpen connection o ReadWriteMode + written <- for fd \f -> loWrite connection f "hello, large object" + traverse_ (loClose connection) fd + pure written + traverse_ (loUnlink connection) oid + pure outcome diff --git a/src/library/Pqi/Conformance/Operation/NewNullConnection.hs b/src/library/Pqi/Conformance/Operation/NewNullConnection.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/NewNullConnection.hs @@ -0,0 +1,22 @@ +-- | Coverage for 'Pqi.newNullConnection': the sentinel \"null\" connection +-- is reported as null and bad. +module Pqi.Conformance.Operation.NewNullConnection + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "newNullConnection" do + it "produces a connection that is null and bad" \conninfo -> + differentialConnect proxy conninfo \(_ :: Proxy c) _ -> do + connection <- newNullConnection :: IO c + nullness <- pure (isNullConnection connection) + badness <- status connection + finish connection + pure (nullness, badness) diff --git a/src/library/Pqi/Conformance/Operation/Nfields.hs b/src/library/Pqi/Conformance/Operation/Nfields.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Nfields.hs @@ -0,0 +1,22 @@ +-- | Coverage for 'Pqi.nfields': the column count across a multi-column +-- result, a zero-column result, and a command result. +module Pqi.Conformance.Operation.Nfields + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "nfields" do + it "counts columns across result shapes" \conninfo -> + differential proxy conninfo \connection -> do + let countOf sql = exec connection sql >>= traverse nfields + several <- countOf "select 1, 2, 3" + zero <- countOf "select" + command <- countOf "create temporary table conformance_nfields (id int4)" + pure (several, zero, command) diff --git a/src/library/Pqi/Conformance/Operation/Notifies.hs b/src/library/Pqi/Conformance/Operation/Notifies.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Notifies.hs @@ -0,0 +1,57 @@ +-- | Coverage for 'Pqi.notifies': @LISTEN@\/@NOTIFY@ delivery, queueing, +-- and that @UNLISTEN@ stops delivery. +-- +-- The backend PID carried by a notification is connection-specific — the +-- candidate and the reference are distinct backends — so 'bePid' is omitted +-- from the cross-adapter comparison. Each scenario that receives a +-- notification instead asserts independently (per adapter) that +-- @notification.bePid == backendPID connection@, verifying that the PID field +-- is correctly populated without comparing it across adapters. +module Pqi.Conformance.Operation.Notifies + ( spec, + ) +where + +import Pqi (IsConnection (..), Notify (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "notifies" do + it "is empty with no pending notifications" \conninfo -> + differential proxy conninfo \connection -> + fmap channelAndPayload <$> notifies connection + + it "delivers a listen/notify round-trip and then drains" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "listen conformance_channel" + _ <- exec connection "notify conformance_channel, 'payload-1'" + notification <- notifies connection + pid <- backendPID connection + for_ notification \n -> n.bePid `shouldBe` pid + drained <- fmap channelAndPayload <$> notifies connection + pure (fmap channelAndPayload notification, drained) + + it "queues notifications in order" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "listen conformance_channel" + _ <- exec connection "notify conformance_channel, 'first'" + _ <- exec connection "notify conformance_channel, 'second'" + first <- notifies connection + second <- notifies connection + third <- notifies connection + pid <- backendPID connection + for_ first \n -> n.bePid `shouldBe` pid + for_ second \n -> n.bePid `shouldBe` pid + pure (fmap channelAndPayload first, fmap channelAndPayload second, fmap channelAndPayload third) + + it "stops delivery after unlisten" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "listen conformance_channel" + _ <- exec connection "unlisten conformance_channel" + _ <- exec connection "notify conformance_channel, 'lost'" + fmap channelAndPayload <$> notifies connection + where + channelAndPayload notification = (notification.relname, notification.extra) diff --git a/src/library/Pqi/Conformance/Operation/Nparams.hs b/src/library/Pqi/Conformance/Operation/Nparams.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Nparams.hs @@ -0,0 +1,26 @@ +-- | Coverage for 'Pqi.nparams': the parameter count of a +-- 'Pqi.describePrepared' result. +module Pqi.Conformance.Operation.Nparams + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "nparams" do + it "counts the parameters of a prepared statement" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_nparams" "select $1 :: int4, $2 :: text" Nothing + described <- describePrepared connection "conformance_nparams" + for described nparams + + it "is zero for a parameterless statement" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_nparams_zero" "select 42" Nothing + described <- describePrepared connection "conformance_nparams_zero" + for described nparams diff --git a/src/library/Pqi/Conformance/Operation/Ntuples.hs b/src/library/Pqi/Conformance/Operation/Ntuples.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Ntuples.hs @@ -0,0 +1,22 @@ +-- | Coverage for 'Pqi.ntuples': the row count across a multi-row result, +-- an empty result, and a command result. +module Pqi.Conformance.Operation.Ntuples + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "ntuples" do + it "counts rows across result shapes" \conninfo -> + differential proxy conninfo \connection -> do + let countOf sql = exec connection sql >>= traverse ntuples + many <- countOf "select i from generate_series (1, 3) as i" + none <- countOf "select 1 where false" + command <- countOf "create temporary table conformance_ntuples (id int4)" + pure (many, none, command) diff --git a/src/library/Pqi/Conformance/Operation/Options.hs b/src/library/Pqi/Conformance/Operation/Options.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Options.hs @@ -0,0 +1,17 @@ +-- | Coverage for 'Pqi.options': the command-line options of the +-- connection request. +module Pqi.Conformance.Operation.Options + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "options" do + it "reports the command-line options from the conninfo" \conninfo -> + differential proxy conninfo options diff --git a/src/library/Pqi/Conformance/Operation/ParameterStatus.hs b/src/library/Pqi/Conformance/Operation/ParameterStatus.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ParameterStatus.hs @@ -0,0 +1,25 @@ +-- | Coverage for 'Pqi.parameterStatus': server-reported parameter +-- settings, including @GUC_REPORT@ updates and an absent parameter. +module Pqi.Conformance.Operation.ParameterStatus + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "parameterStatus" do + it "reports parameter statuses, including GUC_REPORT updates" \conninfo -> + differential proxy conninfo \connection -> do + before <- parameterStatus connection "application_name" + _ <- exec connection "set application_name to 'pqi-conformance'" + after <- parameterStatus connection "application_name" + clientEncoding <- parameterStatus connection "client_encoding" + standardConformingStrings <- parameterStatus connection "standard_conforming_strings" + integerDatetimes <- parameterStatus connection "integer_datetimes" + missing <- parameterStatus connection "no_such_parameter" + pure (before, after, clientEncoding, standardConformingStrings, integerDatetimes, missing) diff --git a/src/library/Pqi/Conformance/Operation/Paramtype.hs b/src/library/Pqi/Conformance/Operation/Paramtype.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Paramtype.hs @@ -0,0 +1,31 @@ +-- | Coverage for 'Pqi.paramtype': the data-type OID of each parameter of +-- a 'Pqi.describePrepared' result, both inferred and explicitly typed. +module Pqi.Conformance.Operation.Paramtype + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (int8Oid) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "paramtype" do + it "reports inferred parameter types" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_paramtype" "select $1 :: int4, $2 :: text" Nothing + described <- describePrepared connection "conformance_paramtype" + for described \r -> do + n <- nparams r + traverse (paramtype r) [0 .. n - 1] + + it "reports explicitly requested parameter types" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_paramtype_typed" "select $1" (Just [int8Oid]) + described <- describePrepared connection "conformance_paramtype_typed" + for described \r -> do + n <- nparams r + traverse (paramtype r) [0 .. n - 1] diff --git a/src/library/Pqi/Conformance/Operation/Pass.hs b/src/library/Pqi/Conformance/Operation/Pass.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Pass.hs @@ -0,0 +1,17 @@ +-- | Coverage for 'Pqi.pass': the password of the connection (absent under +-- the trust-auth conninfo). +module Pqi.Conformance.Operation.Pass + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "pass" do + it "reports the password from the conninfo" \conninfo -> + differential proxy conninfo pass diff --git a/src/library/Pqi/Conformance/Operation/PipelineStatus.hs b/src/library/Pqi/Conformance/Operation/PipelineStatus.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/PipelineStatus.hs @@ -0,0 +1,33 @@ +-- | Coverage for 'Pqi.pipelineStatus': the pipeline-mode status, +-- including the aborted state after an in-pipeline error and recovery at the +-- sync point. +module Pqi.Conformance.Operation.PipelineStatus + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (takeCommandResults, takeResult) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "pipelineStatus" do + it "reports off, on, aborted, and recovery" \conninfo -> + differential proxy conninfo \connection -> do + off <- pipelineStatus connection + _ <- enterPipelineMode connection + on <- pipelineStatus connection + _ <- traverse (\sql -> sendQueryParams connection sql [] Lq.Text) ["select 1", "select 1 / 0", "select 3"] + _ <- pipelineSync connection + _ <- takeCommandResults connection + _ <- takeCommandResults connection + aborted <- pipelineStatus connection + _ <- takeCommandResults connection + _ <- takeResult connection + recovered <- pipelineStatus connection + _ <- exitPipelineMode connection + pure (off, on, aborted, recovered) diff --git a/src/library/Pqi/Conformance/Operation/PipelineSync.hs b/src/library/Pqi/Conformance/Operation/PipelineSync.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/PipelineSync.hs @@ -0,0 +1,56 @@ +-- | Coverage for 'Pqi.pipelineSync': marking a synchronization point that +-- batches pipelined commands, and the abort semantics when one of them fails. +module Pqi.Conformance.Operation.PipelineSync + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (takeCommandResults, takeResult) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "pipelineSync" do + it "collects pipelined queries per sync" \conninfo -> + differential proxy conninfo \connection -> do + entered <- enterPipelineMode connection + sent <- + traverse + (\sql -> sendQueryParams connection sql [] Lq.Text) + ["select 1 :: int4", "select 'two' :: text", "select 3 :: int4, 'three' :: text"] + synced <- pipelineSync connection + first <- takeCommandResults connection + second <- takeCommandResults connection + third <- takeCommandResults connection + syncResult <- takeResult connection + idle <- takeResult connection + exited <- exitPipelineMode connection + pure (entered, sent, synced, first, second, third, syncResult, idle, exited) + + it "aborts the rest of the pipeline after an error" \conninfo -> + differential proxy conninfo \connection -> do + entered <- enterPipelineMode connection + sent <- + traverse + (\sql -> sendQueryParams connection sql [] Lq.Text) + ["select 1", "select 1 / 0", "select 3"] + synced <- pipelineSync connection + first <- takeCommandResults connection + failed <- takeCommandResults connection + aborted <- takeCommandResults connection + syncResult <- takeResult connection + exited <- exitPipelineMode connection + pure (entered, sent, synced, first, failed, aborted, syncResult, exited) + + it "returns a sync result when called without prior commands" \conninfo -> + differential proxy conninfo \connection -> do + entered <- enterPipelineMode connection + synced <- pipelineSync connection + syncResult <- takeResult connection + trailing <- takeResult connection + exited <- exitPipelineMode connection + pure (entered, synced, syncResult, trailing, exited) diff --git a/src/library/Pqi/Conformance/Operation/Port.hs b/src/library/Pqi/Conformance/Operation/Port.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Port.hs @@ -0,0 +1,16 @@ +-- | Coverage for 'Pqi.port': the port of the connection. +module Pqi.Conformance.Operation.Port + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "port" do + it "reports the port from the conninfo" \conninfo -> + differential proxy conninfo port diff --git a/src/library/Pqi/Conformance/Operation/Prepare.hs b/src/library/Pqi/Conformance/Operation/Prepare.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Prepare.hs @@ -0,0 +1,28 @@ +-- | Coverage for 'Pqi.prepare': preparing a named statement, the result +-- it reports, and duplicate-name handling. +module Pqi.Conformance.Operation.Prepare + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "prepare" do + it "reports its own result" \conninfo -> + differential proxy conninfo \connection -> + prepare connection "conformance_prep_result" "select $1 :: int4" Nothing + >>= traverse observeResult + + it "rejects a duplicate statement name" \conninfo -> + differential proxy conninfo \connection -> do + first <- + prepare connection "conformance_dup" "select 1" Nothing >>= traverse observeResult + second <- + prepare connection "conformance_dup" "select 2" Nothing >>= traverse observeResult + pure (first, second) diff --git a/src/library/Pqi/Conformance/Operation/ProtocolVersion.hs b/src/library/Pqi/Conformance/Operation/ProtocolVersion.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ProtocolVersion.hs @@ -0,0 +1,17 @@ +-- | Coverage for 'Pqi.protocolVersion': the frontend/backend protocol +-- version. +module Pqi.Conformance.Operation.ProtocolVersion + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "protocolVersion" do + it "reports the protocol version" \conninfo -> + differential proxy conninfo protocolVersion diff --git a/src/library/Pqi/Conformance/Operation/PutCopyData.hs b/src/library/Pqi/Conformance/Operation/PutCopyData.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/PutCopyData.hs @@ -0,0 +1,36 @@ +-- | Coverage for 'Pqi.putCopyData': streaming rows into a +-- @COPY FROM STDIN@, including malformed data that the server rejects at end. +module Pqi.Conformance.Operation.PutCopyData + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults, execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "putCopyData" do + it "streams rows into a COPY FROM STDIN" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "create temporary table conformance_copy (id int4, label text)" + started <- execScenario "copy conformance_copy from stdin" connection + firstRow <- putCopyData connection "1\thello\n" + secondRow <- putCopyData connection "2\tworld\n" + ended <- putCopyEnd connection Nothing + outcome <- drainResults connection + check <- + execScenario "select count(*), min(label), max(label) from conformance_copy" connection + pure (started, firstRow, secondRow, ended, outcome, check) + + it "feeds malformed data that the server rejects" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "create temporary table conformance_copy_bad (id int4)" + started <- execScenario "copy conformance_copy_bad from stdin" connection + row <- putCopyData connection "not-a-number\n" + ended <- putCopyEnd connection Nothing + outcome <- drainResults connection + pure (started, row, ended, outcome) diff --git a/src/library/Pqi/Conformance/Operation/PutCopyEnd.hs b/src/library/Pqi/Conformance/Operation/PutCopyEnd.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/PutCopyEnd.hs @@ -0,0 +1,35 @@ +-- | Coverage for 'Pqi.putCopyEnd': finishing a @COPY FROM STDIN@, both +-- committing the rows and aborting the copy with a client error. +module Pqi.Conformance.Operation.PutCopyEnd + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults, execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "putCopyEnd" do + it "commits the copied rows when ended without an error" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "create temporary table conformance_copy_end (id int4)" + started <- execScenario "copy conformance_copy_end from stdin" connection + row <- putCopyData connection "1\n" + ended <- putCopyEnd connection Nothing + outcome <- drainResults connection + check <- execScenario "select count(*) from conformance_copy_end" connection + pure (started, row, ended, outcome, check) + + it "aborts the copy when ended with an error" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "create temporary table conformance_copy_abort (id int4)" + started <- execScenario "copy conformance_copy_abort from stdin" connection + row <- putCopyData connection "1\n" + ended <- putCopyEnd connection (Just "conformance abort") + outcome <- drainResults connection + check <- execScenario "select count(*) from conformance_copy_abort" connection + pure (started, row, ended, outcome, check) diff --git a/src/library/Pqi/Conformance/Operation/Reset.hs b/src/library/Pqi/Conformance/Operation/Reset.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Reset.hs @@ -0,0 +1,26 @@ +-- | Coverage for 'Pqi.reset': a blocking reset restores a fresh session, +-- discarding transaction state and prepared statements. +module Pqi.Conformance.Operation.Reset + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "reset" do + it "restores a fresh session" \conninfo -> + differential proxy conninfo \connection -> do + _ <- prepare connection "conformance_reset" "select 1" Nothing + _ <- exec connection "begin" + inTransaction <- transactionStatus connection + reset connection + afterReset <- observeConnection connection + -- The prepared statement must be gone in the fresh session. + describeAfter <- describePrepared connection "conformance_reset" >>= traverse observeResult + pure (inTransaction, afterReset, describeAfter) diff --git a/src/library/Pqi/Conformance/Operation/ResetPoll.hs b/src/library/Pqi/Conformance/Operation/ResetPoll.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ResetPoll.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.resetPoll': driving an asynchronous reset forward +-- until it reports a terminal polling status. +module Pqi.Conformance.Operation.ResetPoll + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (pollUntilDone) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "resetPoll" do + it "reaches a terminal polling status and a ready connection" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "begin" + started <- resetStart connection + terminal <- pollUntilDone (resetPoll connection) + afterStatus <- transactionStatus connection + pure (started, terminal, afterStatus) diff --git a/src/library/Pqi/Conformance/Operation/ResetStart.hs b/src/library/Pqi/Conformance/Operation/ResetStart.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ResetStart.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.resetStart': beginning an asynchronous reset that +-- is then driven to completion with 'Pqi.resetPoll'. +module Pqi.Conformance.Operation.ResetStart + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (pollUntilDone) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "resetStart" do + it "begins an asynchronous reset that polls to a fresh session" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "begin" + started <- resetStart connection + polled <- pollUntilDone (resetPoll connection) + afterReset <- observeConnection connection + pure (started, polled, afterReset) diff --git a/src/library/Pqi/Conformance/Operation/ResultErrorField.hs b/src/library/Pqi/Conformance/Operation/ResultErrorField.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ResultErrorField.hs @@ -0,0 +1,46 @@ +-- | Coverage for 'Pqi.resultErrorField': the structured fields carried by +-- a wire error response — SQLSTATE, severity, primary message, detail, hint, +-- positions, internal query, context, and source location. +-- +-- These all come from the wire error response and are compared in full +-- (via 'Pqi.Conformance.Observation.observeResult', which captures every +-- 'Pqi.FieldCode'). +module Pqi.Conformance.Operation.ResultErrorField + ( spec, + ) +where + +import Pqi (IsConnection) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (execAllScenario, execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "resultErrorField" do + let forCase title sql = + it title \conninfo -> differential proxy conninfo (execScenario sql) + forCase "syntax error" "selct 1" + forCase "undefined table" "select * from pqi_no_such_table" + forCase "undefined column" "select no_such_column from (select 1) as t" + forCase "division by zero" "select 1 / 0" + forCase "statement position past a prefix" "select 1 where tlse" + forCase + "detail, hint, and a custom errcode" + "do $$ begin raise exception 'boom' using detail = 'the detail', hint = 'the hint', errcode = 'P0123'; end $$" + forCase "internal query and position" "do $$ begin execute 'selct 1'; end $$" + forCase "value too long" "select 'abc' :: varchar(2)" + + it "constraint violations" \conninfo -> + differential proxy conninfo + $ execAllScenario + [ "create temporary table conformance_errors (id int4 primary key, label text not null)", + "insert into conformance_errors values (1, 'a')", + "insert into conformance_errors values (1, 'b')", + "insert into conformance_errors values (2, null)" + ] + + it "a failed transaction block rejects further commands" \conninfo -> + differential proxy conninfo + $ execAllScenario ["begin", "select 1 / 0", "select 1", "rollback", "select 1"] diff --git a/src/library/Pqi/Conformance/Operation/ResultErrorMessage.hs b/src/library/Pqi/Conformance/Operation/ResultErrorMessage.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ResultErrorMessage.hs @@ -0,0 +1,31 @@ +-- | Coverage for 'Pqi.resultErrorMessage': the formatted error string on a +-- failed result, and empty on a successful one. +-- +-- The message is compared byte-identically: both adapters must produce the +-- same formatted string as libpq's @PQresultErrorMessage@ at DEFAULT +-- verbosity. The failure scenario uses a @RAISE EXCEPTION@ from a PL\/pgSQL +-- anonymous block, which produces an error without a statement-position field +-- (@'P'@), so the formatted string is fully reproducible from the wire error +-- fields alone. +module Pqi.Conformance.Operation.ResultErrorMessage + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "resultErrorMessage" do + it "matches the full formatted libpq error string on failure and is empty on success" \conninfo -> + differential proxy conninfo \connection -> do + failed <- + exec connection "do $$ begin raise exception 'conformance error'; end $$" + >>= traverse resultErrorMessage + succeeded <- + exec connection "select 1" + >>= traverse resultErrorMessage + pure (failed, succeeded) diff --git a/src/library/Pqi/Conformance/Operation/ResultStatus.hs b/src/library/Pqi/Conformance/Operation/ResultStatus.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ResultStatus.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.resultStatus': the status reported for each kind of +-- result — tuples, a command, an empty query, and a failure. +module Pqi.Conformance.Operation.ResultStatus + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "resultStatus" do + it "reports the status for each kind of result" \conninfo -> + differential proxy conninfo \connection -> do + let statusOf sql = exec connection sql >>= traverse resultStatus + tuples <- statusOf "select 1" + command <- statusOf "create temporary table conformance_status (id int4)" + empty <- statusOf "" + failed <- statusOf "selct 1" + pure (tuples, command, empty, failed) diff --git a/src/library/Pqi/Conformance/Operation/SendDescribePortal.hs b/src/library/Pqi/Conformance/Operation/SendDescribePortal.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SendDescribePortal.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.sendDescribePortal': asynchronously describing a +-- declared cursor's portal. +module Pqi.Conformance.Operation.SendDescribePortal + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "sendDescribePortal" do + it "describes a declared cursor asynchronously" \conninfo -> + differential proxy conninfo \connection -> do + _ <- exec connection "begin" + _ <- exec connection "declare conformance_async_cursor cursor for select 1 :: int4 as n" + sent <- sendDescribePortal connection "conformance_async_cursor" + results <- drainResults connection + pure (sent, results) diff --git a/src/library/Pqi/Conformance/Operation/SendDescribePrepared.hs b/src/library/Pqi/Conformance/Operation/SendDescribePrepared.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SendDescribePrepared.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.sendDescribePrepared': asynchronously describing a +-- prepared statement. +module Pqi.Conformance.Operation.SendDescribePrepared + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "sendDescribePrepared" do + it "describes a prepared statement asynchronously" \conninfo -> + differential proxy conninfo \connection -> do + _ <- sendPrepare connection "conformance_send_desc" "select $1 :: int4 * 2" Nothing + _ <- drainResults connection + sent <- sendDescribePrepared connection "conformance_send_desc" + results <- drainResults connection + pure (sent, results) diff --git a/src/library/Pqi/Conformance/Operation/SendFlushRequest.hs b/src/library/Pqi/Conformance/Operation/SendFlushRequest.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SendFlushRequest.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.sendFlushRequest': asking the server to flush its +-- output buffer so pipelined results arrive without a 'Pqi.pipelineSync'. +module Pqi.Conformance.Operation.SendFlushRequest + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (takeCommandResults, takeResult) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "sendFlushRequest" do + it "delivers results without a sync" \conninfo -> + differential proxy conninfo \connection -> do + entered <- enterPipelineMode connection + sent <- sendQueryParams connection "select 42" [] Lq.Text + flushRequested <- sendFlushRequest connection + results <- takeCommandResults connection + synced <- pipelineSync connection + syncResult <- takeResult connection + exited <- exitPipelineMode connection + pure (entered, sent, flushRequested, results, synced, syncResult, exited) diff --git a/src/library/Pqi/Conformance/Operation/SendPrepare.hs b/src/library/Pqi/Conformance/Operation/SendPrepare.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SendPrepare.hs @@ -0,0 +1,21 @@ +-- | Coverage for 'Pqi.sendPrepare': asynchronously preparing a named +-- statement and collecting its result. +module Pqi.Conformance.Operation.SendPrepare + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "sendPrepare" do + it "prepares a statement asynchronously" \conninfo -> + differential proxy conninfo \connection -> do + sent <- sendPrepare connection "conformance_send_prepare" "select $1 :: int4 * 2" Nothing + results <- drainResults connection + pure (sent, results) diff --git a/src/library/Pqi/Conformance/Operation/SendQuery.hs b/src/library/Pqi/Conformance/Operation/SendQuery.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SendQuery.hs @@ -0,0 +1,30 @@ +-- | Coverage for 'Pqi.sendQuery': submitting a command without waiting, +-- then collecting its results, including multi-statement scripts, a mid-script +-- error, and the empty query. +module Pqi.Conformance.Operation.SendQuery + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "sendQuery" do + let sendAndDrain sql conninfo = + differential proxy conninfo \connection -> do + sent <- sendQuery connection sql + results <- drainResults connection + pure (sent, results) + it "sends a query and collects its result" + $ sendAndDrain "select i, i * 10 from generate_series (1, 3) as i" + it "yields multiple results for multiple statements" + $ sendAndDrain "select 1; select 2, 3; select 4" + it "ends the results at a mid-script error" + $ sendAndDrain "select 1; select 1 / 0; select 3" + it "handles an empty string" + $ sendAndDrain "" diff --git a/src/library/Pqi/Conformance/Operation/SendQueryParams.hs b/src/library/Pqi/Conformance/Operation/SendQueryParams.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SendQueryParams.hs @@ -0,0 +1,27 @@ +-- | Coverage for 'Pqi.sendQueryParams': the asynchronous parameterized +-- query, including a null parameter. +module Pqi.Conformance.Operation.SendQueryParams + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults, int4Oid) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "sendQueryParams" do + it "sends a parameterized query and collects its result" \conninfo -> + differential proxy conninfo \connection -> do + sent <- + sendQueryParams + connection + "select $1 :: int4 + $2 :: int4, $3 :: text" + [Just (int4Oid, "40", Lq.Text), Just (int4Oid, "2", Lq.Text), Nothing] + Lq.Text + results <- drainResults connection + pure (sent, results) diff --git a/src/library/Pqi/Conformance/Operation/SendQueryPrepared.hs b/src/library/Pqi/Conformance/Operation/SendQueryPrepared.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SendQueryPrepared.hs @@ -0,0 +1,24 @@ +-- | Coverage for 'Pqi.sendQueryPrepared': asynchronously executing a +-- previously prepared statement. +module Pqi.Conformance.Operation.SendQueryPrepared + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "sendQueryPrepared" do + it "executes a prepared statement asynchronously" \conninfo -> + differential proxy conninfo \connection -> do + _ <- sendPrepare connection "conformance_send_exec" "select $1 :: int4 * 2" Nothing + _ <- drainResults connection + sent <- sendQueryPrepared connection "conformance_send_exec" [Just ("21", Lq.Text)] Lq.Text + results <- drainResults connection + pure (sent, results) diff --git a/src/library/Pqi/Conformance/Operation/ServerVersion.hs b/src/library/Pqi/Conformance/Operation/ServerVersion.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/ServerVersion.hs @@ -0,0 +1,17 @@ +-- | Coverage for 'Pqi.serverVersion': the server version as an @MMmmpp@ +-- integer. +module Pqi.Conformance.Operation.ServerVersion + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "serverVersion" do + it "reports the server version as an integer" \conninfo -> + differential proxy conninfo serverVersion diff --git a/src/library/Pqi/Conformance/Operation/SetClientEncoding.hs b/src/library/Pqi/Conformance/Operation/SetClientEncoding.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SetClientEncoding.hs @@ -0,0 +1,23 @@ +-- | Coverage for 'Pqi.setClientEncoding': changing the client encoding, +-- including rejection of an unknown encoding (which leaves the session intact). +module Pqi.Conformance.Operation.SetClientEncoding + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "setClientEncoding" do + it "rejects an unknown encoding and leaves the session usable" \conninfo -> + differential proxy conninfo \connection -> do + rejected <- setClientEncoding connection "BOGUS_ENCODING" + unchanged <- clientEncoding connection + stillIdle <- transactionStatus connection + stillWorks <- execScenario "select 1" connection + pure (rejected, unchanged, stillIdle, stillWorks) diff --git a/src/library/Pqi/Conformance/Operation/SetErrorVerbosity.hs b/src/library/Pqi/Conformance/Operation/SetErrorVerbosity.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SetErrorVerbosity.hs @@ -0,0 +1,22 @@ +-- | Coverage for 'Pqi.setErrorVerbosity': setting error verbosity, which +-- returns the previous setting. +module Pqi.Conformance.Operation.SetErrorVerbosity + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import qualified Pqi as Lq +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "setErrorVerbosity" do + it "returns the previous setting" \conninfo -> + differential proxy conninfo \connection -> do + beforeTerse <- setErrorVerbosity connection Lq.ErrorsTerse + beforeVerbose <- setErrorVerbosity connection Lq.ErrorsVerbose + beforeDefault <- setErrorVerbosity connection Lq.ErrorsDefault + pure (beforeTerse, beforeVerbose, beforeDefault) diff --git a/src/library/Pqi/Conformance/Operation/SetSingleRowMode.hs b/src/library/Pqi/Conformance/Operation/SetSingleRowMode.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/SetSingleRowMode.hs @@ -0,0 +1,29 @@ +-- | Coverage for 'Pqi.setSingleRowMode': delivering the rows of the +-- currently executing query one result at a time. +module Pqi.Conformance.Operation.SetSingleRowMode + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (drainResults) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "setSingleRowMode" do + it "splits a multi-row result into single-row results" \conninfo -> + differential proxy conninfo \connection -> do + sent <- sendQuery connection "select i from generate_series (1, 3) as i" + singleRow <- setSingleRowMode connection + results <- drainResults connection + pure (sent, singleRow, results) + + it "handles an empty result" \conninfo -> + differential proxy conninfo \connection -> do + sent <- sendQuery connection "select 1 where false" + singleRow <- setSingleRowMode connection + results <- drainResults connection + pure (sent, singleRow, results) diff --git a/src/library/Pqi/Conformance/Operation/Setnonblocking.hs b/src/library/Pqi/Conformance/Operation/Setnonblocking.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Setnonblocking.hs @@ -0,0 +1,22 @@ +-- | Coverage for 'Pqi.setnonblocking': toggling the connection's +-- non-blocking flag. +module Pqi.Conformance.Operation.Setnonblocking + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "setnonblocking" do + it "turns the non-blocking flag on and off" \conninfo -> + differential proxy conninfo \connection -> do + setOn <- setnonblocking connection True + nowOn <- isnonblocking connection + setOff <- setnonblocking connection False + nowOff <- isnonblocking connection + pure (setOn, nowOn, setOff, nowOff) diff --git a/src/library/Pqi/Conformance/Operation/Socket.hs b/src/library/Pqi/Conformance/Operation/Socket.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Socket.hs @@ -0,0 +1,20 @@ +-- | Coverage for 'Pqi.socket': the connection's socket file descriptor. +-- +-- The descriptor number itself is per-connection identity, so only its +-- presence on an open connection is compared. +module Pqi.Conformance.Operation.Socket + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "socket" do + it "is present on an open connection" \conninfo -> + differential proxy conninfo \connection -> + isJust <$> socket connection diff --git a/src/library/Pqi/Conformance/Operation/Status.hs b/src/library/Pqi/Conformance/Operation/Status.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/Status.hs @@ -0,0 +1,16 @@ +-- | Coverage for 'Pqi.status': the current connection status. +module Pqi.Conformance.Operation.Status + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "status" do + it "reports a ready connection as OK" \conninfo -> + differential proxy conninfo status diff --git a/src/library/Pqi/Conformance/Operation/TransactionStatus.hs b/src/library/Pqi/Conformance/Operation/TransactionStatus.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/TransactionStatus.hs @@ -0,0 +1,25 @@ +-- | Coverage for 'Pqi.transactionStatus': in-transaction status tracking +-- across a successful command, a failed command, and a rollback. +module Pqi.Conformance.Operation.TransactionStatus + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "transactionStatus" do + it "tracks status through a transaction" \conninfo -> + differential proxy conninfo \connection -> do + idle <- transactionStatus connection + _ <- exec connection "begin" + inTransaction <- transactionStatus connection + _ <- exec connection "select 1 / 0" + inError <- transactionStatus connection + _ <- exec connection "rollback" + afterRollback <- transactionStatus connection + pure (idle, inTransaction, inError, afterRollback) diff --git a/src/library/Pqi/Conformance/Operation/UnsafeFreeResult.hs b/src/library/Pqi/Conformance/Operation/UnsafeFreeResult.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/UnsafeFreeResult.hs @@ -0,0 +1,26 @@ +-- | Coverage for 'Pqi.unsafeFreeResult': freeing a result leaves the +-- connection usable for subsequent commands. +-- +-- An observation of a freed result must not be compared: with the C-backed +-- adapter the accessors share the @PGresult@'s storage, so freeing invalidates +-- previously returned bytes. The example therefore frees and then runs a fresh +-- query, observing only the latter. +module Pqi.Conformance.Operation.UnsafeFreeResult + ( spec, + ) +where + +import Pqi (IsConnection (..), IsResult (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Pqi.Conformance.Scenario (execScenario) +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "unsafeFreeResult" do + it "leaves the connection usable" \conninfo -> + differential proxy conninfo \connection -> do + result <- exec connection "select 1" + traverse_ unsafeFreeResult result + execScenario "select 2" connection diff --git a/src/library/Pqi/Conformance/Operation/User.hs b/src/library/Pqi/Conformance/Operation/User.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Operation/User.hs @@ -0,0 +1,16 @@ +-- | Coverage for 'Pqi.user': the user name of the connection. +module Pqi.Conformance.Operation.User + ( spec, + ) +where + +import Pqi (IsConnection (..)) +import Pqi.Conformance.Harness +import Pqi.Conformance.Prelude +import Test.Hspec + +spec :: (IsConnection c) => Proxy c -> SpecWith ByteString +spec proxy = + describe "user" do + it "reports the user name from the conninfo" \conninfo -> + differential proxy conninfo user diff --git a/src/library/Pqi/Conformance/Prelude.hs b/src/library/Pqi/Conformance/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Prelude.hs @@ -0,0 +1,18 @@ +module Pqi.Conformance.Prelude + ( module Exports, + ) +where + +import Control.Applicative as Exports +import Control.Concurrent as Exports (threadDelay) +import Control.Monad as Exports +import Data.ByteString as Exports (ByteString) +import Data.Either as Exports (isLeft, isRight) +import Data.Foldable as Exports (for_, traverse_) +import Data.Int as Exports +import Data.Maybe as Exports +import Data.Proxy as Exports (Proxy (..)) +import Data.Text as Exports (Text) +import Data.Traversable as Exports (for) +import Data.Word as Exports +import Prelude as Exports diff --git a/src/library/Pqi/Conformance/Reference.hs b/src/library/Pqi/Conformance/Reference.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Reference.hs @@ -0,0 +1,299 @@ +-- | The reference connection: a direct @postgresql-libpq@ wrapper used as the +-- ground truth in differential tests. It is intentionally independent of the +-- @pqi-ffi@ adapter so that adapter test suites can depend on +-- @pqi-conformance@ without a circular dependency through @pqi-ffi@. +module Pqi.Conformance.Reference + ( Reference (..), + RefResult (..), + RefCancel (..), + ) +where + +import qualified Database.PostgreSQL.LibPQ as LibPQ +import Pqi + ( IsCancel (..), + IsConnection (..), + IsResult (..), + ) +import qualified Pqi +import Pqi.Conformance.Prelude + +-- | A direct wrapper over a @postgresql-libpq@ connection, used as the +-- differential-testing reference. +newtype Reference = Reference LibPQ.Connection + +-- | A result backed by a C @PGresult@. +newtype RefResult = RefResult LibPQ.Result + +-- | A cancellation handle backed by a C @PGcancel@. +newtype RefCancel = RefCancel LibPQ.Cancel + +instance IsResult RefResult where + resultStatus (RefResult r) = fromExecStatus <$> LibPQ.resultStatus r + resultErrorMessage (RefResult r) = LibPQ.resultErrorMessage r + resultErrorField (RefResult r) field = LibPQ.resultErrorField r (toFieldCode field) + unsafeFreeResult (RefResult r) = LibPQ.unsafeFreeResult r + ntuples (RefResult r) = fromRow <$> LibPQ.ntuples r + nfields (RefResult r) = fromColumn <$> LibPQ.nfields r + fname (RefResult r) column = LibPQ.fname r (toColumn column) + fnumber (RefResult r) name = fmap fromColumn <$> LibPQ.fnumber r name + ftable (RefResult r) column = fromOid <$> LibPQ.ftable r (toColumn column) + ftablecol (RefResult r) column = fromColumn <$> LibPQ.ftablecol r (toColumn column) + fformat (RefResult r) column = fromFormat <$> LibPQ.fformat r (toColumn column) + ftype (RefResult r) column = fromOid <$> LibPQ.ftype r (toColumn column) + fmod (RefResult r) column = LibPQ.fmod r (toColumn column) + fsize (RefResult r) column = LibPQ.fsize r (toColumn column) + getvalue (RefResult r) row column = LibPQ.getvalue r (toRow row) (toColumn column) + getvalue' (RefResult r) row column = LibPQ.getvalue' r (toRow row) (toColumn column) + getisnull (RefResult r) row column = LibPQ.getisnull r (toRow row) (toColumn column) + getlength (RefResult r) row column = LibPQ.getlength r (toRow row) (toColumn column) + nparams (RefResult r) = fromIntegral <$> LibPQ.nparams r + paramtype (RefResult r) index = fromOid <$> LibPQ.paramtype r (fromIntegral index) + cmdStatus (RefResult r) = LibPQ.cmdStatus r + cmdTuples (RefResult r) = LibPQ.cmdTuples r + +instance IsCancel RefCancel where + cancel (RefCancel handle) = LibPQ.cancel handle + +instance IsConnection Reference where + type ResultOf Reference = RefResult + type CancelOf Reference = RefCancel + + connectdb conninfo = Reference <$> LibPQ.connectdb conninfo + connectStart conninfo = Reference <$> LibPQ.connectStart conninfo + connectPoll (Reference c) = fromPollingStatus <$> LibPQ.connectPoll c + newNullConnection = Reference <$> LibPQ.newNullConnection + isNullConnection (Reference c) = LibPQ.isNullConnection c + finish (Reference c) = LibPQ.finish c + reset (Reference c) = LibPQ.reset c + resetStart (Reference c) = LibPQ.resetStart c + resetPoll (Reference c) = fromPollingStatus <$> LibPQ.resetPoll c + db (Reference c) = LibPQ.db c + user (Reference c) = LibPQ.user c + pass (Reference c) = LibPQ.pass c + host (Reference c) = LibPQ.host c + port (Reference c) = LibPQ.port c + options (Reference c) = LibPQ.options c + status (Reference c) = fromConnStatus <$> LibPQ.status c + transactionStatus (Reference c) = fromTransactionStatus <$> LibPQ.transactionStatus c + parameterStatus (Reference c) name = LibPQ.parameterStatus c name + protocolVersion (Reference c) = LibPQ.protocolVersion c + serverVersion (Reference c) = LibPQ.serverVersion c + errorMessage (Reference c) = LibPQ.errorMessage c + socket (Reference c) = LibPQ.socket c + backendPID (Reference c) = fromIntegral <$> LibPQ.backendPID c + connectionNeedsPassword (Reference c) = LibPQ.connectionNeedsPassword c + connectionUsedPassword (Reference c) = LibPQ.connectionUsedPassword c + + exec (Reference c) sql = + fmap RefResult <$> LibPQ.exec c sql + execParams (Reference c) sql params resultFormat = + fmap RefResult <$> LibPQ.execParams c sql (fmap (fmap toParam) params) (toFormat resultFormat) + prepare (Reference c) name sql paramTypes = + fmap RefResult <$> LibPQ.prepare c name sql (fmap (fmap toOid) paramTypes) + execPrepared (Reference c) name params resultFormat = + fmap RefResult <$> LibPQ.execPrepared c name (fmap (fmap toBoundParam) params) (toFormat resultFormat) + describePrepared (Reference c) name = + fmap RefResult <$> LibPQ.describePrepared c name + describePortal (Reference c) name = + fmap RefResult <$> LibPQ.describePortal c name + + escapeStringConn (Reference c) = LibPQ.escapeStringConn c + escapeByteaConn (Reference c) = LibPQ.escapeByteaConn c + escapeIdentifier (Reference c) = LibPQ.escapeIdentifier c + + sendQuery (Reference c) sql = LibPQ.sendQuery c sql + sendQueryParams (Reference c) sql params resultFormat = + LibPQ.sendQueryParams c sql (fmap (fmap toParam) params) (toFormat resultFormat) + sendPrepare (Reference c) name sql paramTypes = + LibPQ.sendPrepare c name sql (fmap (fmap toOid) paramTypes) + sendQueryPrepared (Reference c) name params resultFormat = + LibPQ.sendQueryPrepared c name (fmap (fmap toBoundParam) params) (toFormat resultFormat) + sendDescribePrepared (Reference c) name = LibPQ.sendDescribePrepared c name + sendDescribePortal (Reference c) name = LibPQ.sendDescribePortal c name + getResult (Reference c) = fmap RefResult <$> LibPQ.getResult c + consumeInput (Reference c) = LibPQ.consumeInput c + isBusy (Reference c) = LibPQ.isBusy c + setnonblocking (Reference c) nonBlocking = LibPQ.setnonblocking c nonBlocking + isnonblocking (Reference c) = LibPQ.isnonblocking c + setSingleRowMode (Reference c) = LibPQ.setSingleRowMode c + flush (Reference c) = fromFlushStatus <$> LibPQ.flush c + + pipelineStatus (Reference c) = fromPipelineStatus <$> LibPQ.pipelineStatus c + enterPipelineMode (Reference c) = LibPQ.enterPipelineMode c + exitPipelineMode (Reference c) = LibPQ.exitPipelineMode c + pipelineSync (Reference c) = LibPQ.pipelineSync c + sendFlushRequest (Reference c) = LibPQ.sendFlushRequest c + + getCancel (Reference c) = fmap RefCancel <$> LibPQ.getCancel c + + notifies (Reference c) = fmap fromNotify <$> LibPQ.notifies c + disableNoticeReporting (Reference c) = LibPQ.disableNoticeReporting c + enableNoticeReporting (Reference c) = LibPQ.enableNoticeReporting c + getNotice (Reference c) = LibPQ.getNotice c + + putCopyData (Reference c) value = fromCopyInResult <$> LibPQ.putCopyData c value + putCopyEnd (Reference c) reason = fromCopyInResult <$> LibPQ.putCopyEnd c reason + getCopyData (Reference c) nonBlocking = fromCopyOutResult <$> LibPQ.getCopyData c nonBlocking + + loCreat (Reference c) = fmap fromOid <$> LibPQ.loCreat c + loCreate (Reference c) oid = fmap fromOid <$> LibPQ.loCreate c (toOid oid) + loImport (Reference c) path = fmap fromOid <$> LibPQ.loImport c path + loImportWithOid (Reference c) path oid = fmap fromOid <$> LibPQ.loImportWithOid c path (toOid oid) + loExport (Reference c) oid path = LibPQ.loExport c (toOid oid) path + loOpen (Reference c) oid mode = fmap fromLibPQLoFd <$> LibPQ.loOpen c (toOid oid) mode + loWrite (Reference c) fd value = LibPQ.loWrite c (toLibPQLoFd fd) value + loRead (Reference c) fd len = LibPQ.loRead c (toLibPQLoFd fd) len + loSeek (Reference c) fd mode offset = LibPQ.loSeek c (toLibPQLoFd fd) mode offset + loTell (Reference c) fd = LibPQ.loTell c (toLibPQLoFd fd) + loTruncate (Reference c) fd len = LibPQ.loTruncate c (toLibPQLoFd fd) len + loClose (Reference c) fd = LibPQ.loClose c (toLibPQLoFd fd) + loUnlink (Reference c) oid = LibPQ.loUnlink c (toOid oid) + + clientEncoding (Reference c) = LibPQ.clientEncoding c + setClientEncoding (Reference c) encoding = LibPQ.setClientEncoding c encoding + setErrorVerbosity (Reference c) verbosity = + fromVerbosity <$> LibPQ.setErrorVerbosity c (toVerbosity verbosity) + +-- * Type conversions + +toParam :: (Word32, ByteString, Pqi.Format) -> (LibPQ.Oid, ByteString, LibPQ.Format) +toParam (oid, value, format) = (toOid oid, value, toFormat format) + +toBoundParam :: (ByteString, Pqi.Format) -> (ByteString, LibPQ.Format) +toBoundParam (value, format) = (value, toFormat format) + +toOid :: Word32 -> LibPQ.Oid +toOid = LibPQ.Oid . fromIntegral + +fromOid :: LibPQ.Oid -> Word32 +fromOid (LibPQ.Oid value) = fromIntegral value + +toRow :: Int32 -> LibPQ.Row +toRow = LibPQ.toRow + +fromRow :: LibPQ.Row -> Int32 +fromRow = fromIntegral . fromEnum + +toColumn :: Int32 -> LibPQ.Column +toColumn = LibPQ.toColumn + +fromColumn :: LibPQ.Column -> Int32 +fromColumn = fromIntegral . fromEnum + +toLibPQLoFd :: Int32 -> LibPQ.LoFd +toLibPQLoFd = LibPQ.LoFd . fromIntegral + +fromLibPQLoFd :: LibPQ.LoFd -> Int32 +fromLibPQLoFd (LibPQ.LoFd fd) = fromIntegral fd + +fromNotify :: LibPQ.Notify -> Pqi.Notify +fromNotify notification = + Pqi.Notify + { Pqi.relname = LibPQ.notifyRelname notification, + Pqi.bePid = fromIntegral (LibPQ.notifyBePid notification), + Pqi.extra = LibPQ.notifyExtra notification + } + +toFormat :: Pqi.Format -> LibPQ.Format +toFormat = \case + Pqi.Text -> LibPQ.Text + Pqi.Binary -> LibPQ.Binary + +fromFormat :: LibPQ.Format -> Pqi.Format +fromFormat = \case + LibPQ.Text -> Pqi.Text + LibPQ.Binary -> Pqi.Binary + +fromExecStatus :: LibPQ.ExecStatus -> Pqi.ExecStatus +fromExecStatus = \case + LibPQ.EmptyQuery -> Pqi.EmptyQuery + LibPQ.CommandOk -> Pqi.CommandOk + LibPQ.TuplesOk -> Pqi.TuplesOk + LibPQ.CopyOut -> Pqi.CopyOut + LibPQ.CopyIn -> Pqi.CopyIn + LibPQ.CopyBoth -> Pqi.CopyBoth + LibPQ.BadResponse -> Pqi.BadResponse + LibPQ.NonfatalError -> Pqi.NonfatalError + LibPQ.FatalError -> Pqi.FatalError + LibPQ.SingleTuple -> Pqi.SingleTuple + LibPQ.PipelineSync -> Pqi.PipelineSync + LibPQ.PipelineAbort -> Pqi.PipelineAbort + +fromConnStatus :: LibPQ.ConnStatus -> Pqi.ConnStatus +fromConnStatus = \case + LibPQ.ConnectionOk -> Pqi.ConnectionOk + LibPQ.ConnectionBad -> Pqi.ConnectionBad + LibPQ.ConnectionStarted -> Pqi.ConnectionStarted + LibPQ.ConnectionMade -> Pqi.ConnectionMade + LibPQ.ConnectionAwaitingResponse -> Pqi.ConnectionAwaitingResponse + LibPQ.ConnectionAuthOk -> Pqi.ConnectionAuthOk + LibPQ.ConnectionSetEnv -> Pqi.ConnectionSetEnv + LibPQ.ConnectionSSLStartup -> Pqi.ConnectionSSLStartup + +fromTransactionStatus :: LibPQ.TransactionStatus -> Pqi.TransactionStatus +fromTransactionStatus = \case + LibPQ.TransIdle -> Pqi.TransIdle + LibPQ.TransActive -> Pqi.TransActive + LibPQ.TransInTrans -> Pqi.TransInTrans + LibPQ.TransInError -> Pqi.TransInError + LibPQ.TransUnknown -> Pqi.TransUnknown + +fromPollingStatus :: LibPQ.PollingStatus -> Pqi.PollingStatus +fromPollingStatus = \case + LibPQ.PollingFailed -> Pqi.PollingFailed + LibPQ.PollingReading -> Pqi.PollingReading + LibPQ.PollingWriting -> Pqi.PollingWriting + LibPQ.PollingOk -> Pqi.PollingOk + +fromPipelineStatus :: LibPQ.PipelineStatus -> Pqi.PipelineStatus +fromPipelineStatus = \case + LibPQ.PipelineOn -> Pqi.PipelineOn + LibPQ.PipelineOff -> Pqi.PipelineOff + LibPQ.PipelineAborted -> Pqi.PipelineAborted + +fromFlushStatus :: LibPQ.FlushStatus -> Pqi.FlushStatus +fromFlushStatus = \case + LibPQ.FlushOk -> Pqi.FlushOk + LibPQ.FlushFailed -> Pqi.FlushFailed + LibPQ.FlushWriting -> Pqi.FlushWriting + +fromCopyInResult :: LibPQ.CopyInResult -> Pqi.CopyInResult +fromCopyInResult = \case + LibPQ.CopyInOk -> Pqi.CopyInOk + LibPQ.CopyInError -> Pqi.CopyInError + LibPQ.CopyInWouldBlock -> Pqi.CopyInWouldBlock + +fromCopyOutResult :: LibPQ.CopyOutResult -> Pqi.CopyOutResult +fromCopyOutResult = \case + LibPQ.CopyOutRow value -> Pqi.CopyOutRow value + LibPQ.CopyOutWouldBlock -> Pqi.CopyOutWouldBlock + LibPQ.CopyOutDone -> Pqi.CopyOutDone + LibPQ.CopyOutError -> Pqi.CopyOutError + +toVerbosity :: Pqi.Verbosity -> LibPQ.Verbosity +toVerbosity = \case + Pqi.ErrorsTerse -> LibPQ.ErrorsTerse + Pqi.ErrorsDefault -> LibPQ.ErrorsDefault + Pqi.ErrorsVerbose -> LibPQ.ErrorsVerbose + +fromVerbosity :: LibPQ.Verbosity -> Pqi.Verbosity +fromVerbosity = \case + LibPQ.ErrorsTerse -> Pqi.ErrorsTerse + LibPQ.ErrorsDefault -> Pqi.ErrorsDefault + LibPQ.ErrorsVerbose -> Pqi.ErrorsVerbose + +toFieldCode :: Pqi.FieldCode -> LibPQ.FieldCode +toFieldCode = \case + Pqi.DiagSeverity -> LibPQ.DiagSeverity + Pqi.DiagSqlstate -> LibPQ.DiagSqlstate + Pqi.DiagMessagePrimary -> LibPQ.DiagMessagePrimary + Pqi.DiagMessageDetail -> LibPQ.DiagMessageDetail + Pqi.DiagMessageHint -> LibPQ.DiagMessageHint + Pqi.DiagStatementPosition -> LibPQ.DiagStatementPosition + Pqi.DiagInternalPosition -> LibPQ.DiagInternalPosition + Pqi.DiagInternalQuery -> LibPQ.DiagInternalQuery + Pqi.DiagContext -> LibPQ.DiagContext + Pqi.DiagSourceFile -> LibPQ.DiagSourceFile + Pqi.DiagSourceLine -> LibPQ.DiagSourceLine + Pqi.DiagSourceFunction -> LibPQ.DiagSourceFunction diff --git a/src/library/Pqi/Conformance/Scenario.hs b/src/library/Pqi/Conformance/Scenario.hs new file mode 100644 --- /dev/null +++ b/src/library/Pqi/Conformance/Scenario.hs @@ -0,0 +1,155 @@ +-- | Reusable scenario fragments shared by the per-operation spec modules. +-- +-- These are the recurring building blocks — running a query and observing its +-- result, draining the asynchronous result stream, collecting a @COPY OUT@ +-- stream, driving a polling loop to its terminal status, and the handful of +-- well-known type OIDs — factored out so each operation module stays focused on +-- the one operation it covers. +module Pqi.Conformance.Scenario + ( -- * Running queries + execScenario, + execAllScenario, + observed, + + -- * Asynchronous result collection + drainResults, + takeResult, + takeCommandResults, + + -- * Copy and polling loops + collectCopyOut, + pollUntilDone, + flushUntilDone, + + -- * Transactions + inTransaction, + + -- * Well-known type OIDs + boolOid, + byteaOid, + int2Oid, + int4Oid, + int8Oid, + textOid, + float8Oid, + ) +where + +import Pqi + ( CopyOutResult (..), + FlushStatus (..), + IsConnection (..), + PollingStatus (..), + ) +import qualified Pqi as Lq +import Pqi.Conformance.Observation +import Pqi.Conformance.Prelude + +-- | Run 'Pqi.exec' and observe its result (if any). +execScenario :: (IsConnection c) => ByteString -> c -> IO (Maybe ResultObservation) +execScenario sql connection = exec connection sql >>= traverse observeResult + +-- | Run a sequence of statements with 'Pqi.exec', observing every result. +execAllScenario :: (IsConnection c) => [ByteString] -> c -> IO [Maybe ResultObservation] +execAllScenario sqls connection = traverse (`execScenario` connection) sqls + +-- | Run 'Pqi.execParams' and observe its result (if any). +observed :: + (IsConnection c) => + ByteString -> + [Maybe (Word32, ByteString, Lq.Format)] -> + Lq.Format -> + c -> + IO (Maybe ResultObservation) +observed sql params resultFormat connection = + execParams connection sql params resultFormat >>= traverse observeResult + +-- | Collect and observe results with 'Pqi.getResult' until it reports +-- completion with 'Nothing'. +drainResults :: (IsConnection c) => c -> IO [ResultObservation] +drainResults connection = go [] + where + go acc = + getResult connection >>= \case + Nothing -> pure (reverse acc) + Just result -> do + observation <- observeResult result + go (observation : acc) + +-- | One 'Pqi.getResult' step, observed. +takeResult :: (IsConnection c) => c -> IO (Maybe ResultObservation) +takeResult connection = getResult connection >>= traverse observeResult + +-- | The results of one pipelined command: its result and the 'Nothing' +-- separator that ends it. +takeCommandResults :: + (IsConnection c) => c -> IO (Maybe ResultObservation, Maybe ResultObservation) +takeCommandResults connection = do + result <- takeResult connection + separator <- takeResult connection + pure (result, separator) + +-- | Collect blocking 'Pqi.getCopyData' outcomes until the stream reports +-- anything other than a row (normally 'CopyOutDone'), including that final +-- outcome. +collectCopyOut :: (IsConnection c) => c -> IO [CopyOutResult] +collectCopyOut connection = go (1000 :: Int) [] + where + go 0 acc = pure (reverse acc) + go n acc = + getCopyData connection False >>= \case + CopyOutRow row -> go (n - 1) (CopyOutRow row : acc) + terminal -> pure (reverse (terminal : acc)) + +-- | Drive a polling loop to its terminal status, spinning with a small delay +-- instead of waiting on the socket. Bails out as failed after ten seconds. +pollUntilDone :: IO PollingStatus -> IO PollingStatus +pollUntilDone poll = go (10000 :: Int) + where + go 0 = pure PollingFailed + go n = + poll >>= \case + PollingReading -> threadDelay 1000 >> go (n - 1) + PollingWriting -> threadDelay 1000 >> go (n - 1) + terminal -> pure terminal + +-- | Drive 'Pqi.flush' to a terminal status, spinning while it reports +-- 'FlushWriting'. Bails out as failed after ten seconds. +flushUntilDone :: IO FlushStatus -> IO FlushStatus +flushUntilDone doFlush = go (10000 :: Int) + where + go 0 = pure FlushFailed + go n = + doFlush >>= \case + FlushWriting -> threadDelay 1000 >> go (n - 1) + terminal -> pure terminal + +-- | Run an action between @begin@ and @commit@. Large-object operations must +-- run inside a transaction block. +inTransaction :: (IsConnection c) => c -> IO a -> IO a +inTransaction connection action = do + _ <- exec connection "begin" + result <- action + _ <- exec connection "commit" + pure result + +boolOid :: Word32 +boolOid = 16 + +byteaOid :: Word32 +byteaOid = 17 + +int2Oid :: Word32 +int2Oid = 21 + +int4Oid :: Word32 +int4Oid = 23 + +int8Oid :: Word32 +int8Oid = 20 + +textOid :: Word32 +textOid = 25 + +float8Oid :: Word32 +float8Oid = 701