@@ -0,0 +1,540 @@
1+module Test.Postgres.Behavioral where
2+
3+import Prelude
4+
5+import Control.Parallel (parTraverse)
6+import Data.Array as Array
7+import Data.Date (canonicalDate)
8+import Data.DateTime (DateTime(..))
9+import Data.Either (Either(..))
10+import Data.Enum (toEnum)
11+import Data.Maybe (Maybe(..), fromJust)
12+import Data.Identity (Identity)
13+import Data.Time (Time(..))
14+import Data.Time.Duration (Milliseconds(..))
15+import Data.UUID as UUID
16+import Effect (Effect)
17+import Effect.Aff (Aff, delay, forkAff, killFiber, throwError, try)
18+import Effect.Class (liftEffect)
19+import Effect.Exception (error, message)
20+import Effect.Ref as Ref
21+import Effect.Uncurried (EffectFn1, runEffectFn1)
22+import Foreign (unsafeToForeign)
23+import JS.BigInt (BigInt)
24+import JS.BigInt as BigInt
25+import Partial.Unsafe (unsafePartial)
26+import Prim.Boolean (True)
27+import Test.Spec (Spec, SpecT, describe, it)
28+import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
29+import Type.Function (type (#))
30+import Type.Proxy (Proxy(..))
31+import Yoga.Postgres as PG
32+import Yoga.Postgres.Schema as Schema
33+import Yoga.Postgres.TypedQuery as Typed
34+import Yoga.SQL.PostgresTypes (SQLQuery, arg, combineBuilders, int, sql, str)
35+
36+isLeft :: forall a b. Either a b -> Boolean
37+isLeft (Left _) = true
38+isLeft _ = false
39+
40+poisonRollback :: PG.Transaction -> Effect Unit
41+poisonRollback = runEffectFn1 poisonRollbackImpl
42+
43+foreign import poisonRollbackImpl :: EffectFn1 PG.Transaction Unit
44+
45+testConnection :: Effect PG.Connection
46+testConnection = PG.postgres
47+ { host: PG.PostgresHost "localhost"
48+ , port: PG.PostgresPort 5434
49+ , database: PG.PostgresDatabase "test_playground"
50+ , username: PG.PostgresUsername "postgres"
51+ , password: PG.PostgresPassword "postgres"
52+ }
53+
54+type BehaviorTable = Schema.Table "behavior_values"
55+ ( id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
56+ , name :: String
57+ , optional_int :: Maybe Int
58+ )
59+
60+behaviorTable :: Proxy BehaviorTable
61+behaviorTable = Proxy
62+
63+type AllDefaultTable = Schema.Table "behavior_defaults"
64+ ( active :: Boolean # Schema.Default True
65+ , id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
66+ )
67+
68+allDefaultTable :: Proxy AllDefaultTable
69+allDefaultTable = Proxy
70+
71+type TxTable = Schema.Table "behavior_tx"
72+ ( id :: Int # Schema.PrimaryKey # Schema.AutoIncrement
73+ , name :: String
74+ )
75+
76+txTable :: Proxy TxTable
77+txTable = Proxy
78+
79+type TemporalParamTable = Schema.Table "behavior_temporal"
80+ ( document :: Schema.Jsonb
81+ , event_at :: Schema.TimestampTZ
82+ , event_date :: Schema.PGDate
83+ , event_time :: Schema.PGTime
84+ , label :: String
85+ , uuid :: Schema.PGUUID
86+ , optional_event_at :: Maybe Schema.TimestampTZ
87+ )
88+
89+temporalParamTable :: Proxy TemporalParamTable
90+temporalParamTable = Proxy
91+
92+typedIntQuery :: SQLQuery (n :: Int)
93+typedIntQuery = sql $ combineBuilders (combineBuilders "SELECT " (int @"n")) "::int AS n"
94+
95+typedMaybeQuery :: SQLQuery (value :: Maybe Int)
96+typedMaybeQuery = sql $ combineBuilders (combineBuilders "SELECT " (arg @(Maybe Int) @"value")) "::int AS value"
97+
98+typedBadDecodeQuery :: SQLQuery ()
99+typedBadDecodeQuery = sql $ combineBuilders "SELECT 'not-an-int' AS n" ""
100+
101+typedMutationQuery :: SQLQuery (name :: String)
102+typedMutationQuery = sql $ combineBuilders (combineBuilders "INSERT INTO behavior_values (name) VALUES (" (str @"name")) ")"
103+
104+expectedDate :: Schema.PGDate
105+expectedDate = unsafePartial do
106+ let year = fromJust (toEnum 2025)
107+ let month = fromJust (toEnum 6)
108+ let day = fromJust (toEnum 15)
109+ Schema.PGDate (canonicalDate year month day)
110+
111+expectedTime :: Schema.PGTime
112+expectedTime = unsafePartial do
113+ let hour = fromJust (toEnum 14)
114+ let minute = fromJust (toEnum 30)
115+ let second = fromJust (toEnum 45)
116+ let millisecond = fromJust (toEnum 125)
117+ Schema.PGTime (Time hour minute second millisecond)
118+
119+expectedHalfSecondTime :: Schema.PGTime
120+expectedHalfSecondTime = unsafePartial do
121+ let hour = fromJust (toEnum 14)
122+ let minute = fromJust (toEnum 30)
123+ let second = fromJust (toEnum 45)
124+ let millisecond = fromJust (toEnum 500)
125+ Schema.PGTime (Time hour minute second millisecond)
126+
127+expectedTimestamp :: Schema.TimestampTZ
128+expectedTimestamp = unsafePartial do
129+ let year = fromJust (toEnum 2025)
130+ let month = fromJust (toEnum 1)
131+ let day = fromJust (toEnum 15)
132+ let hour = fromJust (toEnum 12)
133+ let minute = fromJust (toEnum 0)
134+ let second = fromJust (toEnum 0)
135+ let millisecond = fromJust (toEnum 0)
136+ Schema.TimestampTZ (DateTime (canonicalDate year month day) (Time hour minute second millisecond))
137+
138+setupBehaviorTable :: PG.Connection -> Aff Unit
139+setupBehaviorTable conn = do
140+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_values") conn
141+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @BehaviorTable)) conn
142+ pure unit
143+
144+setupTxTable :: PG.Connection -> Aff Unit
145+setupTxTable conn = do
146+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_tx") conn
147+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @TxTable)) conn
148+ pure unit
149+
150+setupTemporalParamTable :: PG.Connection -> Aff Unit
151+setupTemporalParamTable conn = do
152+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_temporal") conn
153+ _ <- PG.executeSimple (PG.SQL (Schema.createTableDDL @TemporalParamTable)) conn
154+ pure unit
155+
156+pureSpec :: Spec Unit
157+pureSpec = do
158+ describe "Postgres schema metadata and deterministic SQL" do
159+ it "renders every public scalar, array, and nullable type name" do
160+ Schema.pgTypeName (Proxy :: Proxy Int) `shouldEqual` "INTEGER"
161+ Schema.pgTypeName (Proxy :: Proxy String) `shouldEqual` "TEXT"
162+ Schema.pgTypeName (Proxy :: Proxy Boolean) `shouldEqual` "BOOLEAN"
163+ Schema.pgTypeName (Proxy :: Proxy Number) `shouldEqual` "DOUBLE PRECISION"
164+ Schema.pgTypeName (Proxy :: Proxy BigInt) `shouldEqual` "BIGINT"
165+ Schema.pgTypeName (Proxy :: Proxy Schema.PGUUID) `shouldEqual` "UUID"
166+ Schema.pgTypeName (Proxy :: Proxy Schema.PGDate) `shouldEqual` "DATE"
167+ Schema.pgTypeName (Proxy :: Proxy Schema.PGTime) `shouldEqual` "TIME"
168+ Schema.pgTypeName (Proxy :: Proxy Schema.TimestampTZ) `shouldEqual` "TIMESTAMPTZ"
169+ Schema.pgTypeName (Proxy :: Proxy Schema.Point) `shouldEqual` "POINT"
170+ Schema.pgTypeName (Proxy :: Proxy Schema.TSVector) `shouldEqual` "TSVECTOR"
171+ Schema.pgTypeName (Proxy :: Proxy Schema.TSQuery) `shouldEqual` "TSQUERY"
172+ Schema.pgTypeName (Proxy :: Proxy Schema.Jsonb) `shouldEqual` "JSONB"
173+ Schema.pgTypeName (Proxy :: Proxy (Array Int)) `shouldEqual` "INTEGER[]"
174+ Schema.pgTypeName (Proxy :: Proxy (Maybe Int)) `shouldEqual` "INTEGER"
175+
176+ it "reports nullability from Maybe only" do
177+ Schema.isNullable (Proxy :: Proxy (Maybe Int)) `shouldEqual` true
178+ Schema.isNullable (Proxy :: Proxy Int) `shouldEqual` false
179+
180+ it "renders IF NOT EXISTS and DEFAULT VALUES DDL" do
181+ Schema.createTableDDLIfNotExists @BehaviorTable
182+ `shouldEqual` "CREATE TABLE IF NOT EXISTS behavior_values (id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, name TEXT NOT NULL, optional_int INTEGER)"
183+ Schema.insertSQLFor @AllDefaultTable
184+ `shouldEqual` "INSERT INTO behavior_defaults DEFAULT VALUES RETURNING *"
185+ (Schema.into allDefaultTable # Schema.insert {} # Schema.toSQL)
186+ `shouldEqual` "INSERT INTO behavior_defaults DEFAULT VALUES"
187+
188+ it "renders update entrypoint and all set-operation variants" do
189+ (Schema.update behaviorTable # Schema.set { name: "updated" } # Schema.where_ @"id = $id" # Schema.toSQL)
190+ `shouldEqual` "UPDATE behavior_values SET name = $1 WHERE id = $id"
191+ let left = Schema.from behaviorTable # Schema.select @"name"
192+ let right = Schema.from behaviorTable # Schema.select @"name"
193+ (left `Schema.intersectAll` right # Schema.toSQL)
194+ `shouldEqual` "(SELECT name FROM behavior_values) INTERSECT ALL (SELECT name FROM behavior_values)"
195+ (left `Schema.exceptAll` right # Schema.toSQL)
196+ `shouldEqual` "(SELECT name FROM behavior_values) EXCEPT ALL (SELECT name FROM behavior_values)"
197+
198+ it "renders CTEs and merges their named parameters" do
199+ let adults = Schema.cte @"adults" (Schema.from behaviorTable # Schema.select @"name" # Schema.where_ @"optional_int > $age")
200+ let mainQuery = Schema.fromCTE @"adults" adults # Schema.select @"name"
201+ (Schema.with_ adults mainQuery # Schema.toSQL)
202+ `shouldEqual` "WITH adults AS (SELECT name FROM behavior_values WHERE optional_int > $age) SELECT name FROM adults"
203+
204+ it "replaces repeated named parameters and preserves casts" do
205+ let replaced = Schema.replaceNamedParams 2
206+ [ { name: "id", value: unsafeToForeign 7 }
207+ , { name: "name", value: unsafeToForeign "Alice" }
208+ ]
209+ "id = $id::int OR parent_id = $id AND name = $name"
210+ replaced.sql `shouldEqual` "id = $3 OR parent_id = $3 AND name = $4"
211+ Array.length replaced.values `shouldEqual` 2
212+ Schema.stripCast "$id::uuid" `shouldEqual` "$id"
213+
214+ it "decodes rows and rejects mismatched result shapes" do
215+ let decoded = Schema.decodeRows
216+ [ unsafeToForeign { id: 1, name: "ok" }
217+ , unsafeToForeign { id: 2, name: "also ok" }
218+ ] :: Either _ (Array { id :: Int, name :: String })
219+ decoded `shouldEqual` Right [ { id: 1, name: "ok" }, { id: 2, name: "also ok" } ]
220+ let bad = Schema.decodeRow (unsafeToForeign { id: "wrong" }) :: Either _ { id :: Int }
221+ bad `shouldSatisfy` isLeft
222+ let fractionalTime = Schema.decodeRow (unsafeToForeign { value: "14:30:45.5" }) :: Either _ { value :: Schema.PGTime }
223+ fractionalTime `shouldEqual` Right { value: expectedHalfSecondTime }
224+
225+integrationSpec :: SpecT Aff PG.Connection Identity Unit
226+integrationSpec = do
227+ describe "How to use the public Postgres API" do
228+ it "reports query metadata and preserves heterogeneous and homogeneous parameters" \conn -> do
229+ result <- PG.query
230+ (PG.SQL "SELECT $1::int AS minimum, $2::int AS maximum, $3::double precision AS huge, $4::text AS first, $5::text AS second, $6::int[] AS integers")
231+ ( PG.param (bottom :: Int)
232+ <> PG.param (top :: Int)
233+ <> PG.param 1.5e200
234+ <> PG.params [ "first", "second" ]
235+ <> PG.param [ bottom :: Int, top :: Int ]
236+ )
237+ conn
238+ result.command `shouldEqual` "SELECT"
239+ result.count `shouldEqual` 1
240+ case Schema.decodeRows result.rows of
241+ Left errs -> throwError (error (show errs))
242+ Right rows -> rows `shouldEqual`
243+ [ { minimum: bottom :: Int
244+ , maximum: top :: Int
245+ , huge: 1.5e200
246+ , first: "first"
247+ , second: "second"
248+ , integers: [ bottom :: Int, top :: Int ]
249+ }
250+ ]
251+
252+ it "round-trips UUID, JSON, date, time, timestamp, arrays, and bigint rows" \conn -> do
253+ uuid <- liftEffect UUID.genUUID
254+ result <- PG.query
255+ (PG.SQL "SELECT $1::uuid AS uuid, $2::jsonb AS document, $3::date AS event_date, $4::time AS event_time, $5::timestamptz AS event_at, $6::text[] AS tags, $7::bigint AS big")
256+ [ PG.toPGValue uuid
257+ , PG.toPGValue (unsafeToForeign { key: "value", nested: { count: 2 } })
258+ , PG.toPGValue "2025-06-15"
259+ , PG.toPGValue "14:30:45.125"
260+ , PG.toPGValue "2025-01-15T12:00:00.000Z"
261+ , PG.toPGValue [ "a", "b" ]
262+ , PG.toPGValue "9223372036854775807"
263+ ]
264+ conn
265+ case Schema.decodeRows result.rows of
266+ Left errs -> throwError (error (show errs))
267+ Right rows -> rows `shouldEqual`
268+ [ { uuid: Schema.PGUUID uuid
269+ , document: { key: "value", nested: { count: 2 } }
270+ , event_date: expectedDate
271+ , event_time: expectedTime
272+ , event_at: expectedTimestamp
273+ , tags: [ "a", "b" ]
274+ , big: BigInt.fromString "9223372036854775807" # unsafePartial fromJust
275+ }
276+ ]
277+
278+ it "distinguishes query-one, unsafe exact-row, and no-row behavior" \conn -> do
279+ one <- PG.queryOneSimple (PG.SQL "SELECT 41::int AS value") conn
280+ case one of
281+ Nothing -> throwError (error "expected queryOneSimple row")
282+ Just row -> Schema.decodeRow row `shouldEqual` Right { value: 41 }
283+ exact <- PG.unsafe (PG.SQL "SELECT $1::int AS value") [ PG.toPGValue 42 ] conn
284+ Schema.decodeRow exact `shouldEqual` Right { value: 42 }
285+ missing <- PG.queryOneSimple (PG.SQL "SELECT 1 WHERE false") conn
286+ case missing of
287+ Nothing -> pure unit
288+ Just _ -> throwError (error "expected queryOneSimple to return Nothing")
289+ unsafeMissing <- try $ PG.unsafe (PG.SQL "SELECT 1 WHERE false") [] conn
290+ case unsafeMissing of
291+ Left _ -> pure unit
292+ Right _ -> throwError (error "expected unsafe to reject an empty result")
293+
294+ it "returns affected rows including zero matches" \conn -> do
295+ setupBehaviorTable conn
296+ inserted <- PG.execute (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1), ($2)") (PG.params [ "a", "b" ]) conn
297+ inserted `shouldEqual` 2
298+ updated <- PG.execute (PG.SQL "UPDATE behavior_values SET name = $1 WHERE name = $2") (PG.params [ "updated", "missing" ]) conn
299+ updated `shouldEqual` 0
300+ deleted <- PG.executeSimple (PG.SQL "DELETE FROM behavior_values") conn
301+ deleted `shouldEqual` 2
302+
303+ it "executes typed queries, Maybe parameters, raw results, mutations, and decode errors" \conn -> do
304+ setupBehaviorTable conn
305+ rows <- (Typed.executeSql typedIntQuery { n: 7 } conn :: Aff (Either String (Array { n :: Int })))
306+ rows `shouldEqual` Right [ { n: 7 } ]
307+ nullable <- (Typed.executeSql typedMaybeQuery { value: Nothing } conn :: Aff (Either String (Array { value :: Maybe Int })))
308+ nullable `shouldEqual` Right [ { value: Nothing } ]
309+ raw <- Typed.executeSqlRaw typedIntQuery { n: 8 } conn
310+ raw.count `shouldEqual` 1
311+ one <- (Typed.executeSqlOne typedIntQuery { n: 9 } conn :: Aff (Either String (Maybe { n :: Int })))
312+ one `shouldEqual` Right (Just { n: 9 })
313+ noRows <- (Typed.executeSqlOne (sql $ combineBuilders "SELECT 1::int AS n WHERE false" "") {} conn :: Aff (Either String (Maybe { n :: Int })))
314+ noRows `shouldEqual` Right (Nothing :: Maybe { n :: Int })
315+ many <- (Typed.executeSqlOne (sql $ combineBuilders "SELECT generate_series(1, 2)::int AS n" "") {} conn :: Aff (Either String (Maybe { n :: Int })))
316+ many `shouldEqual` Right (Nothing :: Maybe { n :: Int })
317+ bad <- (Typed.executeSql typedBadDecodeQuery {} conn :: Aff (Either String (Array { n :: Int })))
318+ bad `shouldSatisfy` isLeft
319+ affected <- Typed.executeMutation typedMutationQuery { name: "typed" } conn
320+ affected `shouldEqual` 1
321+
322+ it "uses schema wrappers as typed query parameters" \conn -> do
323+ setupTemporalParamTable conn
324+ uuid <- liftEffect UUID.genUUID
325+ let pgUuid = Schema.PGUUID uuid
326+ let document = unsafeToForeign { key: "value", nested: { count: 2 } }
327+ _ <- PG.execute
328+ (PG.SQL "INSERT INTO behavior_temporal (document, event_at, event_date, event_time, label, uuid) VALUES ($1, $2, $3, $4, $5, $6)")
329+ [ PG.toPGValue document
330+ , PG.toPGValue "2025-01-15T12:00:00.000Z"
331+ , PG.toPGValue "2025-06-15"
332+ , PG.toPGValue "14:30:45.125"
333+ , PG.toPGValue "matched"
334+ , PG.toPGValue (UUID.toString uuid)
335+ ]
336+ conn
337+ byDate <- Schema.from temporalParamTable
338+ # Schema.select @"label"
339+ # Schema.where_ @"event_date = $date"
340+ # Schema.runQuery conn { date: expectedDate }
341+ byTime <- Schema.from temporalParamTable
342+ # Schema.select @"label"
343+ # Schema.where_ @"event_time = $time"
344+ # Schema.runQuery conn { time: expectedTime }
345+ byTimestamp <- Schema.from temporalParamTable
346+ # Schema.select @"label"
347+ # Schema.where_ @"event_at = $timestamp"
348+ # Schema.runQuery conn { timestamp: expectedTimestamp }
349+ byDocument <- Schema.from temporalParamTable
350+ # Schema.select @"label"
351+ # Schema.where_ @"document @> $document"
352+ # Schema.runQuery conn { document: Schema.Jsonb document }
353+ byDate `shouldEqual` [ { label: "matched" } ]
354+ byTime `shouldEqual` [ { label: "matched" } ]
355+ byTimestamp `shouldEqual` [ { label: "matched" } ]
356+ byDocument `shouldEqual` [ { label: "matched" } ]
357+ inserted <- Schema.into temporalParamTable
358+ # Schema.insert
359+ { document: Schema.Jsonb document
360+ , event_at: expectedTimestamp
361+ , event_date: expectedDate
362+ , event_time: expectedTime
363+ , label: "typed"
364+ , uuid: pgUuid
365+ }
366+ # Schema.runExecute conn {}
367+ inserted `shouldEqual` 1
368+ allRows <- PG.querySimple (PG.SQL "SELECT label FROM behavior_temporal ORDER BY label") conn
369+ decoded <- case Schema.decodeRows allRows.rows of
370+ Left errs -> throwError (error (show errs))
371+ Right values -> pure values
372+ decoded `shouldEqual` [ { label: "matched" }, { label: "typed" } ]
373+
374+ it "converts Just values through the inner field encoder" \conn -> do
375+ setupTemporalParamTable conn
376+ uuid <- liftEffect UUID.genUUID
377+ let document = unsafeToForeign { key: "nullable timestamp" }
378+ inserted <- Schema.into temporalParamTable
379+ # Schema.insert
380+ { document: Schema.Jsonb document
381+ , event_at: expectedTimestamp
382+ , event_date: expectedDate
383+ , event_time: expectedTime
384+ , label: "nullable"
385+ , optional_event_at: Just expectedTimestamp
386+ , uuid: Schema.PGUUID uuid
387+ }
388+ # Schema.runExecute conn {}
389+ inserted `shouldEqual` 1
390+ rows <- Schema.from temporalParamTable
391+ # Schema.select @"optional_event_at"
392+ # Schema.runQuery conn {}
393+ rows `shouldEqual` [ { optional_event_at: Just expectedTimestamp } ]
394+
395+ it "use begin/commit/rollback when transaction boundaries are explicit" \conn -> do
396+ setupTxTable conn
397+ committed <- PG.begin conn
398+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "committed" ] committed
399+ inTransaction <- PG.txQuery (PG.SQL "SELECT name FROM behavior_tx WHERE name = $1") [ PG.toPGValue "committed" ] committed
400+ inTransaction.count `shouldEqual` 1
401+ PG.commit committed
402+ afterCommit <- PG.querySimple (PG.SQL "SELECT name FROM behavior_tx") conn
403+ afterCommit.count `shouldEqual` 1
404+
405+ rolledBack <- PG.begin conn
406+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "rolled back" ] rolledBack
407+ PG.rollback rolledBack
408+ afterRollback <- PG.querySimple (PG.SQL "SELECT name FROM behavior_tx") conn
409+ afterRollback.count `shouldEqual` 1
410+
411+
412+ it "let transaction roll back SQL errors and return the connection to the pool" \conn -> do
413+ setupTxTable conn
414+ result <- try $ PG.withTransaction (\txn -> do
415+ _ <- PG.txExecute (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)") [ PG.toPGValue "before error" ] txn
416+ _ <- PG.txExecute (PG.SQL "INSERT INTO missing_behavior_table VALUES ($1)") [ PG.toPGValue 1 ] txn
417+ pure unit
418+ ) conn
419+ result `shouldSatisfy` isLeft
420+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_tx") conn
421+ rows.count `shouldEqual` 0
422+ PG.ping conn >>= (_ `shouldEqual` true)
423+
424+ it "preserves the action failure when rollback also fails" \conn -> do
425+ result <- try $ PG.withTransaction
426+ (\txn -> do
427+ liftEffect $ poisonRollback txn
428+ throwError (error "action failed")
429+ )
430+ conn
431+ case result of
432+ Left cause -> message cause `shouldEqual` "action failed"
433+ Right _ -> throwError (error "expected transaction to fail")
434+ PG.ping conn >>= (_ `shouldEqual` true)
435+
436+ it "let transaction roll back cancellation and return the connection to the pool" \conn -> do
437+ setupTxTable conn
438+ wrote <- liftEffect $ Ref.new false
439+ fiber <- forkAff $ PG.withTransaction
440+ (\txn -> do
441+ _ <- PG.txExecute
442+ (PG.SQL "INSERT INTO behavior_tx (name) VALUES ($1)")
443+ [ PG.toPGValue "cancelled" ]
444+ txn
445+ liftEffect $ Ref.write true wrote
446+ delay (Milliseconds 10000.0)
447+ )
448+ conn
449+ delay (Milliseconds 50.0)
450+ didWrite <- liftEffect $ Ref.read wrote
451+ didWrite `shouldEqual` true
452+ killFiber (error "cancel transaction") fiber
453+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_tx") conn
454+ rows.count `shouldEqual` 0
455+ PG.ping conn >>= (_ `shouldEqual` true)
456+
457+ it "releases the reserved connection when commit itself fails" \_ -> do
458+ own <- liftEffect $ PG.postgres
459+ { host: PG.PostgresHost "localhost"
460+ , port: PG.PostgresPort 5434
461+ , database: PG.PostgresDatabase "test_playground"
462+ , username: PG.PostgresUsername "postgres"
463+ , password: PG.PostgresPassword "postgres"
464+ , max: PG.MaxConnections 1
465+ }
466+ _ <- PG.executeSimple (PG.SQL "DROP TABLE IF EXISTS behavior_commit_failure") own
467+ _ <- PG.executeSimple
468+ (PG.SQL "CREATE TABLE behavior_commit_failure (name TEXT UNIQUE DEFERRABLE INITIALLY DEFERRED)")
469+ own
470+ txn <- PG.begin own
471+ _ <- PG.txExecute
472+ (PG.SQL "INSERT INTO behavior_commit_failure (name) VALUES ($1), ($2)")
473+ [ PG.toPGValue "duplicate", PG.toPGValue "duplicate" ]
474+ txn
475+ commitResult <- try $ PG.commit txn
476+ commitResult `shouldSatisfy` isLeft
477+ PG.ping own >>= (_ `shouldEqual` true)
478+ PG.end own
479+
480+
481+ it "supports deterministic concurrent pool queries" \conn -> do
482+ setupBehaviorTable conn
483+ counts <- parTraverse
484+ (\n -> PG.execute (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1)") [ PG.toPGValue ("worker-" <> show n) ] conn)
485+ (Array.range 1 8)
486+ counts `shouldEqual` Array.replicate 8 1
487+ rows <- PG.querySimple (PG.SQL "SELECT * FROM behavior_values") conn
488+ rows.count `shouldEqual` 8
489+
490+ it "delivers notifications and actually unsubscribes" \conn -> do
491+ received <- liftEffect $ Ref.new ([] :: Array String)
492+ let channel = PG.Channel "behavior_notifications"
493+ PG.listen channel (\notification -> Ref.modify_ (_ <> [ notification.payload ]) received) conn
494+ PG.notify channel "before-unlisten" conn
495+ delay (Milliseconds 100.0)
496+ liftEffect (Ref.read received) >>= (_ `shouldEqual` [ "before-unlisten" ])
497+ PG.unlisten channel conn
498+ PG.notify channel "after-unlisten" conn
499+ delay (Milliseconds 100.0)
500+ liftEffect (Ref.read received) >>= (_ `shouldEqual` [ "before-unlisten" ])
501+
502+ it "rejects missing and deallocated prepared statements" \conn -> do
503+ setupBehaviorTable conn
504+ let name = PG.StatementName "behavior_insert"
505+ missing <- try $ PG.executePrepared name [ PG.toPGValue "x" ] conn
506+ case missing of
507+ Left _ -> pure unit
508+ Right _ -> throwError (error "expected missing prepared statement to fail")
509+ PG.prepare name (PG.SQL "INSERT INTO behavior_values (name) VALUES ($1)") conn
510+ PG.executePrepared name [ PG.toPGValue "prepared" ] conn >>= (_.count >>> (_ `shouldEqual` 1))
511+ PG.deallocate name conn
512+ deallocated <- try $ PG.executePrepared name [ PG.toPGValue "again" ] conn
513+ case deallocated of
514+ Left _ -> pure unit
515+ Right _ -> throwError (error "expected deallocated prepared statement to fail")
516+
517+ it "invokes notice and parameter callbacks as PureScript Effects" \_ -> do
518+ noticeSeen <- liftEffect $ Ref.new false
519+ parameterSeen <- liftEffect $ Ref.new false
520+ callbackConn <- liftEffect $ PG.postgres
521+ { host: PG.PostgresHost "localhost"
522+ , port: PG.PostgresPort 5434
523+ , database: PG.PostgresDatabase "test_playground"
524+ , username: PG.PostgresUsername "postgres"
525+ , password: PG.PostgresPassword "postgres"
526+ , onnotice: Ref.write true noticeSeen
527+ , onparameter: \_ -> Ref.write true parameterSeen
528+ }
529+ _ <- PG.executeSimple (PG.SQL "DO $$ BEGIN RAISE NOTICE 'behavior callback'; END $$") callbackConn
530+ _ <- PG.executeSimple (PG.SQL "SET application_name TO 'yoga-postgres-callback-test'") callbackConn
531+ liftEffect (Ref.read noticeSeen) >>= (_ `shouldEqual` true)
532+ liftEffect (Ref.read parameterSeen) >>= (_ `shouldEqual` true)
533+ PG.end callbackConn
534+
535+ it "connects via connection string and end closes the pool" \_ -> do
536+ own <- liftEffect $ PG.postgres
537+ { connection: PG.ConnectionString "postgres://postgres:postgres@localhost:5434/test_playground" }
538+ PG.ping own >>= (_ `shouldEqual` true)
539+ PG.end own
540+ PG.ping own >>= (_ `shouldEqual` false)