fix: test client bindings

.gitignore

@@ -11,3 +11,4 @@
 .log
 .purs-repl
 .env
+pg

docker-compose.yml

@@ -0,0 +1,9 @@
+version: '3.8'
+services:
+  db:
+    image: 'postgres:16-bookworm'
+    volumes:
+      - './pg:/var/run/postgresql'
+    environment:
+      POSTGRES_USER: 'postgres'
+      POSTGRES_PASSWORD: 'password'

spago.lock

@@ -3,6 +3,7 @@ workspace:
     pg:
       path: ./
       dependencies:
+        - aff
         - aff-promise
         - bifunctors
         - control
@@ -11,6 +12,7 @@ workspace:
         - exceptions
         - foldable-traversable
         - foreign
+        - integers
         - lists
         - maybe
         - mmorph
@@ -20,11 +22,17 @@ workspace:
         - nullable
         - precise-datetime
         - prelude
+        - record
         - simple-json
         - transformers
+        - tuples
+        - typelevel-prelude
         - unsafe-coerce
       test_dependencies:
+        - filterable
         - foreign-object
+        - node-child-process
+        - node-process
         - quickcheck
         - spec
         - spec-quickcheck
@@ -49,6 +57,7 @@ workspace:
         - enums
         - exceptions
         - exists
+        - filterable
         - fixed-points
         - foldable-traversable
         - foreign
@@ -70,7 +79,13 @@ workspace:
         - mmorph
         - newtype
         - node-buffer
+        - node-child-process
         - node-event-emitter
+        - node-fs
+        - node-os
+        - node-path
+        - node-process
+        - node-streams
         - nonempty
         - now
         - nullable
@@ -81,6 +96,7 @@ workspace:
         - parsing
         - partial
         - pipes
+        - posix-types
         - precise-datetime
         - prelude
         - profunctor
@@ -313,6 +329,17 @@ packages:
     integrity: sha256-A0JQHpTfo1dNOj9U5/Fd3xndlRSE0g2IQWOGor2yXn8=
     dependencies:
       - unsafe-coerce
+  filterable:
+    type: registry
+    version: 5.0.0
+    integrity: sha256-cCojJHRnTmpY1j1kegI4CFwghdQ2Fm/8dzM8IlC+lng=
+    dependencies:
+      - arrays
+      - either
+      - foldable-traversable
+      - identity
+      - lists
+      - ordered-collections
   fixed-points:
     type: registry
     version: 7.0.0
@@ -552,6 +579,22 @@ packages:
       - nullable
       - st
       - unsafe-coerce
+  node-child-process:
+    type: registry
+    version: 11.1.0
+    integrity: sha256-vioMNgk8p+CGwlb6T3I3TIir27el85Yg4satLE/I89w=
+    dependencies:
+      - exceptions
+      - foreign
+      - foreign-object
+      - functions
+      - node-event-emitter
+      - node-fs
+      - node-os
+      - node-streams
+      - nullable
+      - posix-types
+      - unsafe-coerce
   node-event-emitter:
     type: registry
     version: 3.0.0
@@ -564,6 +607,85 @@ packages:
       - nullable
       - prelude
       - unsafe-coerce
+  node-fs:
+    type: registry
+    version: 9.1.0
+    integrity: sha256-TzhvGdrwcM0bazDvrWSqh+M/H8GKYf1Na6aGm2Qg4+c=
+    dependencies:
+      - datetime
+      - effect
+      - either
+      - enums
+      - exceptions
+      - functions
+      - integers
+      - js-date
+      - maybe
+      - node-buffer
+      - node-path
+      - node-streams
+      - nullable
+      - partial
+      - prelude
+      - strings
+      - unsafe-coerce
+  node-os:
+    type: registry
+    version: 5.1.0
+    integrity: sha256-K3gcu9AXanN1+qtk1900+Fi+CuO0s3/H/RMNRNgIzso=
+    dependencies:
+      - arrays
+      - bifunctors
+      - console
+      - control
+      - datetime
+      - effect
+      - either
+      - exceptions
+      - foldable-traversable
+      - foreign
+      - foreign-object
+      - functions
+      - maybe
+      - node-buffer
+      - nullable
+      - partial
+      - posix-types
+      - prelude
+      - unsafe-coerce
+  node-path:
+    type: registry
+    version: 5.0.0
+    integrity: sha256-pd82nQ+2l5UThzaxPdKttgDt7xlsgIDLpPG0yxDEdyE=
+    dependencies:
+      - effect
+  node-process:
+    type: registry
+    version: 11.2.0
+    integrity: sha256-+2MQDYChjGbVbapCyJtuWYwD41jk+BntF/kcOTKBMVs=
+    dependencies:
+      - effect
+      - foreign
+      - foreign-object
+      - maybe
+      - node-event-emitter
+      - node-streams
+      - posix-types
+      - prelude
+      - unsafe-coerce
+  node-streams:
+    type: registry
+    version: 9.0.0
+    integrity: sha256-2n6dq7YWleTDmD1Kur/ul7Cn08IvWrScgPf+0PgX2TQ=
+    dependencies:
+      - aff
+      - effect
+      - either
+      - exceptions
+      - node-buffer
+      - node-event-emitter
+      - nullable
+      - prelude
   nonempty:
     type: registry
     version: 7.0.0
@@ -683,6 +805,13 @@ packages:
       - tailrec
       - transformers
       - tuples
+  posix-types:
+    type: registry
+    version: 6.0.0
+    integrity: sha256-ZfFz8RR1lee/o/Prccyeut3Q+9tYd08mlR72sIh6GzA=
+    dependencies:
+      - maybe
+      - prelude
   precise-datetime:
     type: registry
     version: 7.0.0

spago.yaml

@@ -4,6 +4,7 @@ package:
     strict: true
     pedantic_packages: true
   dependencies:
+    - aff
     - aff-promise
     - bifunctors
     - control
@@ -12,6 +13,7 @@ package:
     - exceptions
     - foldable-traversable
     - foreign
+    - integers
     - lists
     - maybe
     - mmorph
@@ -21,13 +23,19 @@ package:
     - nullable
     - precise-datetime
     - prelude
+    - record
     - simple-json
     - transformers
+    - tuples
+    - typelevel-prelude
     - unsafe-coerce
   test:
     main: Test.Main
     dependencies:
+      - filterable
       - foreign-object
+      - node-child-process
+      - node-process
       - quickcheck
       - spec
       - spec-quickcheck

src/Data.Postgres.js

@@ -1,5 +1,5 @@
-import * as Pg from 'pg'
+import Pg from 'pg'
-import * as Range from 'postgres-range'
+import Range from 'postgres-range'
 
 export const null_ = null
 

src/Effect.Postgres.Client.js

@@ -1,23 +1,28 @@
-import {Client} from 'pg'
+import Pg from 'pg'
 
 /** @typedef {{statementTimeout: unknown, queryTimeout: unknown, idleInTransactionTimeout: unknown, connectionTimeout: unknown, applicationName: string}} ClientConfigExtra */
 
-/** @type {(_: {unwrapMillis: (_m: unknown) => number}) => (cfg: import('pg').ClientConfig & ClientConfigExtra) => () => Client} */
+/** @type {(_: {unwrapMillis: (_m: unknown) => number}) => (cfg: Pg.ClientConfig & ClientConfigExtra) => () => Pg.Client} */
-export const makeImpl = ({unwrapMillis}) => cfg => () => {
+export const makeImpl =
-  if ('statementTimeout' in cfg) {
+  ({ unwrapMillis }) =>
-    cfg.statement_timeout = unwrapMillis(cfg.statementTimeout)
+  cfg =>
+  () => {
+    if ('statementTimeout' in cfg) {
+      cfg.statement_timeout = unwrapMillis(cfg.statementTimeout)
+    }
+    if ('queryTimeout' in cfg) {
+      cfg.query_timeout = unwrapMillis(cfg.queryTimeout)
+    }
+    if ('idleInTransactionTimeout' in cfg) {
+      cfg.idle_in_transaction_session_timeout = unwrapMillis(
+        cfg.idleInTransactionTimeout,
+      )
+    }
+    if ('connectionTimeout' in cfg) {
+      cfg.connectionTimeoutMillis = unwrapMillis(cfg.connectionTimeout)
+    }
+    if ('applicationName' in cfg) {
+      cfg.application_name = cfg.applicationName
+    }
+    return new Pg.Client(cfg)
   }
-  if ('queryTimeout' in cfg) {
-    cfg.query_timeout = unwrapMillis(cfg.queryTimeout)
-  }
-  if ('idleInTransactionTimeout' in cfg) {
-    cfg.idle_in_transaction_session_timeout = unwrapMillis(cfg.idleInTransactionTimeout)
-  }
-  if ('connectionTimeout' in cfg) {
-    cfg.connectionTimeoutMillis = unwrapMillis(cfg.connectionTimeout)
-  }
-  if ('applicationName' in cfg) {
-    cfg.application_name = cfg.applicationName
-  }
-  return new Client(cfg)
-}

src/Effect.Postgres.purs

@@ -1,7 +1,3 @@
 module Effect.Postgres where
 
-import Prelude
-
-import Data.Time.Duration (Milliseconds)
-
 foreign import data Pool :: Type

test/Test.Effect.Postgres.Client.purs

@@ -0,0 +1,52 @@
+module Test.Effect.Postgres.Client where
+
+import Prelude
+
+import Control.Monad.Error.Class (try)
+import Data.Array as Array
+import Data.Either (isLeft)
+import Data.Postgres (deserialize, smash)
+import Data.Traversable (traverse)
+import Effect.Aff (Aff)
+import Effect.Aff.Postgres.Client as PG.Aff.Client
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import Effect.Postgres.Client as PG
+import Effect.Postgres.Client as PG.Client
+import Effect.Postgres.Result as Result
+import Node.Path as Path
+import Node.Process (cwd)
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldEqual)
+
+client :: Aff PG.Client
+client = do
+  cwd' <- liftEffect cwd
+  host <- liftEffect $ Path.resolve [ cwd' ] "./pg"
+  liftEffect $ PG.Client.make { host, user: "postgres", password: "password", database: "postgres" }
+
+spec :: Spec Unit
+spec = do
+  describe "Client" do
+    describe "make" do
+      it "does not throw" $ void $ client
+    describe "connect" do
+      it "does not throw" $ PG.Aff.Client.connect =<< client
+    describe "end" do
+      it "does not throw" $ do
+        c <- client
+        PG.Aff.Client.connect c
+        PG.Aff.Client.end c
+    describe "query" do
+      it "ok if connected" $ do
+        c <- client
+        PG.Aff.Client.connect c
+        res <- Result.rows <$> PG.Aff.Client.query "select unnest(array[1, 2, 3])" c
+        ints :: Array Int <- liftEffect $ smash $ traverse deserialize $ Array.catMaybes $ map Array.head res
+        ints `shouldEqual` [ 1, 2, 3 ]
+      it "throws if ended" $ do
+        c <- client
+        PG.Aff.Client.connect c
+        PG.Aff.Client.end c
+        res <- try $ PG.Aff.Client.query "select 1" c
+        isLeft res `shouldEqual` true

test/Test.Main.purs

@@ -2,12 +2,63 @@ module Test.Main where
 
 import Prelude
 
-import Effect (Effect)
+import Control.Alternative (guard)
-import Effect.Aff (launchAff_)
+import Control.Monad.Rec.Class (untilJust)
+import Data.Either (Either(..), hush)
+import Data.Filterable (filter)
+import Data.Maybe (Maybe(..), isNothing, maybe)
+import Data.Newtype (wrap)
+import Data.String as String
+import Effect (Effect, untilE)
+import Effect.Aff (Aff, bracket, delay, launchAff_, makeAff)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import Node.Buffer as Buffer
+import Node.ChildProcess (ChildProcess)
+import Node.ChildProcess as ChildProcess
+import Node.ChildProcess.Aff as ChildProcess.Aff
+import Node.ChildProcess.Types (Exit(..), stringSignal)
+import Node.Encoding (Encoding(..))
+import Node.EventEmitter as Event
 import Test.Data.Postgres as Test.Data.Postgres
-import Test.Spec.Reporter (consoleReporter)
+import Test.Effect.Postgres.Client as Test.Effect.Postgres.Client
+import Test.Spec.Reporter (specReporter)
 import Test.Spec.Runner (runSpec)
 
+spawnDb :: Aff ChildProcess
+spawnDb =
+  let
+    isReady = do
+      { exitStatus, error } <- liftEffect (ChildProcess.spawnSync "docker" [ "compose", "exec", "db", "pg_isready" ])
+      let
+        exitOk (Normally 0) = true
+        exitOk _ = false
+      pure $ isNothing error && exitOk exitStatus
+    waitReady =
+      void $ untilJust do
+        delay $ wrap $ 100.0
+        isReady' <- isReady
+        pure $ filter (const isReady') (Just unit)
+  in
+    do
+      liftEffect $ log $ "[db] starting..."
+      db <- liftEffect $ ChildProcess.spawn "docker" [ "compose", "up" ]
+      waitReady
+      liftEffect $ log $ "[db] started!"
+      pure db
+
+killDb :: ChildProcess -> Aff Unit
+killDb db = do
+  let
+    onexit eff = Event.on ChildProcess.exitH eff db
+    exit = makeAff \res -> mempty <$ onexit (const $ res $ Right unit)
+  _ <- liftEffect $ ChildProcess.kill' (stringSignal "SIGTERM") db
+  exit
+
 main :: Effect Unit
-main = launchAff_ $ runSpec [ consoleReporter ] do
+main = launchAff_ do
-  Test.Data.Postgres.spec
+  bracket spawnDb killDb
+    $ const
+    $ runSpec [ specReporter ] do
+        Test.Data.Postgres.spec
+        Test.Effect.Postgres.Client.spec