From 0d5977829ec8232b345a7b6694a2b48fca764efb Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Mon, 1 Apr 2024 13:46:33 -0500 Subject: [PATCH] test: pool --- src/Effect.Aff.Postgres.Client.purs | 4 +- src/Effect.Postgres.Client.purs | 2 +- src/Effect.Postgres.Pool.purs | 18 ++--- test/Test.Common.purs | 12 +++- test/Test.Effect.Postgres.Client.purs | 22 +++--- test/Test.Effect.Postgres.Pool.js | 2 + test/Test.Effect.Postgres.Pool.purs | 98 +++++++++++++++++++++++++++ test/Test.Event.purs | 29 ++++++++ test/Test.Main.purs | 2 + 9 files changed, 161 insertions(+), 28 deletions(-) create mode 100644 test/Test.Effect.Postgres.Pool.js create mode 100644 test/Test.Effect.Postgres.Pool.purs create mode 100644 test/Test.Event.purs diff --git a/src/Effect.Aff.Postgres.Client.purs b/src/Effect.Aff.Postgres.Client.purs index 9fc0270..0d6f2f3 100644 --- a/src/Effect.Aff.Postgres.Client.purs +++ b/src/Effect.Aff.Postgres.Client.purs @@ -22,8 +22,8 @@ import Prim.Row (class Union) -- | The config parameter `r` is `Config` with all keys optional. -- | -- | This is a shorthand for `(voidRight <*> connect) =<< liftEffect (make cfg)` -connected :: forall r trash. Union r trash (Config ()) => Record r -> Aff Client -connected cfg = (voidRight <*> connect) =<< liftEffect (make cfg) +connected :: forall r missing trash. Union r missing (Config trash) => Record r -> Aff Client +connected cfg = (voidRight <*> connect) =<< liftEffect (make @r @missing @trash cfg) -- | Connects the client to the database -- | diff --git a/src/Effect.Postgres.Client.purs b/src/Effect.Postgres.Client.purs index 62fd1e1..848c720 100644 --- a/src/Effect.Postgres.Client.purs +++ b/src/Effect.Postgres.Client.purs @@ -50,7 +50,7 @@ type Config r = -- | The config parameter `r` is `Config` with all keys optional. -- | -- | -make :: forall r trash. Union r trash (Config ()) => Record r -> Effect Client +make :: forall @r @missing @trash. Union r missing (Config trash) => Record r -> Effect Client make r = do modifyPgTypes __make $ __uncfg { unwrapMillis: unwrap } $ unsafeToForeign r diff --git a/src/Effect.Postgres.Pool.purs b/src/Effect.Postgres.Pool.purs index f96ee84..8315c5e 100644 --- a/src/Effect.Postgres.Pool.purs +++ b/src/Effect.Postgres.Pool.purs @@ -2,12 +2,8 @@ module Effect.Postgres.Pool where import Prelude -import Data.Maybe (Maybe) import Data.Newtype (unwrap) -import Data.Nullable (Nullable) -import Data.Nullable as Nullable import Data.Postgres (modifyPgTypes) -import Data.Profunctor (lcmap) import Data.Time.Duration (Milliseconds) import Effect (Effect) import Effect.Exception (Error) @@ -43,19 +39,19 @@ foreign import clientWaitingCount :: Pool -> Int -- | The config parameter `r` is `Config` with all keys optional. -- | -- | -make :: forall r omitted. Union r omitted (Config ()) => Record r -> Effect Pool +make :: forall r missing trash. Union r missing (Config trash) => Record r -> Effect Pool make r = do modifyPgTypes let asClientConfig = Client.__uncfg { unwrapMillis: unwrap } $ unsafeToForeign r __make $ __uncfg { unwrapMillis: unwrap } $ unsafeToForeign asClientConfig -- | -releaseClient :: Pool -> Client -> Effect Unit -releaseClient p c = __release p c false +release :: Pool -> Client -> Effect Unit +release p c = __release p c false -- | -destroyClient :: Pool -> Client -> Effect Unit -destroyClient p c = __release p c true +destroy :: Pool -> Client -> Effect Unit +destroy p c = __release p c true -- | connectE :: EventHandle1 Pool Client @@ -74,8 +70,8 @@ removeE :: EventHandle1 Pool Client removeE = EventHandle "remove" mkEffectFn1 -- | -releaseE :: EventHandle Pool (Maybe Error -> Client -> Effect Unit) (EffectFn2 (Nullable Error) Client Unit) -releaseE = EventHandle "release" (mkEffectFn2 <<< lcmap Nullable.toMaybe) +releaseE :: EventHandle Pool (Client -> Effect Unit) (EffectFn2 Foreign Client Unit) +releaseE = EventHandle "release" (mkEffectFn2 <<< const) -- | FFI type for `import('pg').PoolConfig` foreign import data PoolConfigRaw :: Type diff --git a/test/Test.Common.purs b/test/Test.Common.purs index dfe0ad9..d46ad10 100644 --- a/test/Test.Common.purs +++ b/test/Test.Common.purs @@ -3,7 +3,7 @@ module Test.Common where import Prelude import Effect (Effect) -import Effect.Aff (Aff, Fiber, bracket, forkAff, joinFiber, launchAff) +import Effect.Aff (Aff, bracket) import Effect.Aff.Postgres.Client (Client) import Effect.Aff.Postgres.Client as Client import Effect.Aff.Postgres.Pool (Pool) @@ -12,6 +12,8 @@ import Effect.Class (liftEffect) import Effect.Unsafe (unsafePerformEffect) import Node.Path as Path import Node.Process (cwd) +import Record (insert) +import Type.Prelude (Proxy(..)) config :: Effect @@ -19,11 +21,12 @@ config , host :: String , password :: String , user :: String + , max :: Int } config = do cwd' <- liftEffect cwd host <- liftEffect $ Path.resolve [ cwd' ] "./pg" - pure { host, user: "postgres", password: "password", database: "postgres" } + pure { host, user: "postgres", password: "password", database: "postgres", max: 3 } withClient :: (Client -> Aff Unit) -> Aff Unit withClient = bracket (Client.connected =<< liftEffect config) Client.end @@ -31,5 +34,8 @@ withClient = bracket (Client.connected =<< liftEffect config) Client.end pool :: Pool pool = unsafePerformEffect $ Pool.make =<< liftEffect config +withPool :: (Pool -> Aff Unit) -> Aff Unit +withPool = bracket (liftEffect $ Pool.make =<< config) Pool.end + withPoolClient :: (Client -> Aff Unit) -> Aff Unit -withPoolClient = bracket (Pool.connect pool) (liftEffect <<< Pool.releaseClient pool) +withPoolClient = bracket (Pool.connect pool) (liftEffect <<< Pool.release pool) diff --git a/test/Test.Effect.Postgres.Client.purs b/test/Test.Effect.Postgres.Client.purs index 268bcfb..4c61ed7 100644 --- a/test/Test.Effect.Postgres.Client.purs +++ b/test/Test.Effect.Postgres.Client.purs @@ -16,6 +16,7 @@ import Effect.Exception as Error import Effect.Uncurried (EffectFn1) import Node.EventEmitter (EventHandle, once) import Test.Common (withClient) +import Test.Event (onceAff) import Test.Spec (Spec, around, describe, it) import Test.Spec.Assertions (shouldEqual) @@ -24,24 +25,23 @@ spec = around withClient do describe "Client" do describe "events" do - let - once_ :: forall a b. EventHandle Client.Client (a -> Effect Unit) (EffectFn1 b Unit) -> Client.Client -> Aff a - once_ e c = makeAff \res -> mempty <$ once e (res <<< Right) c it "end" \c -> do - endEvent <- forkAff $ makeAff \res -> mempty <$ once Client.endE (res $ Right unit) c + expect <- forkAff $ onceAff Client.endE c Client.end c - void $ joinFiber endEvent + joinFiber expect it "notice" \c -> do - noticeEvent <- forkAff $ once_ Client.noticeE c + expect <- forkAff do + e <- onceAff Client.noticeE c + Error.message e `shouldEqual` "hello" void $ Client.exec "do language plpgsql $$ begin raise notice 'hello'; end; $$;" c - e <- joinFiber noticeEvent - Error.message e `shouldEqual` "hello" + joinFiber expect it "notification" \c -> do void $ Client.exec "listen hello;" c - notifEvent <- forkAff $ once_ Client.notificationE c + expect <- forkAff do + n <- onceAff Client.notificationE c + n.payload `shouldEqual` (Just "world") void $ Client.exec "notify hello, 'world';" c - n <- joinFiber notifEvent - n.payload `shouldEqual` (Just "world") + joinFiber expect it "connect & end do not throw" $ const $ pure unit describe "query" do it "ok if connected" \c -> shouldEqual [ 1, 2, 3 ] =<< query "select unnest(array[1, 2, 3])" c diff --git a/test/Test.Effect.Postgres.Pool.js b/test/Test.Effect.Postgres.Pool.js new file mode 100644 index 0000000..c99c822 --- /dev/null +++ b/test/Test.Effect.Postgres.Pool.js @@ -0,0 +1,2 @@ +/** @type {(a: unknown) => (b: unknown) => boolean} */ +export const refEq = a => b => a === b diff --git a/test/Test.Effect.Postgres.Pool.purs b/test/Test.Effect.Postgres.Pool.purs new file mode 100644 index 0000000..3cabd71 --- /dev/null +++ b/test/Test.Effect.Postgres.Pool.purs @@ -0,0 +1,98 @@ +module Test.Effect.Postgres.Pool where + +import Prelude + +import Data.Traversable (traverse) +import Effect.Aff (finally, forkAff, joinFiber) +import Effect.Aff.Postgres.Client as Client +import Effect.Aff.Postgres.Pool as Pool +import Effect.Class (liftEffect) +import Test.Common (config, withPool) +import Test.Event (onceAff) +import Test.Spec (Spec, around, describe, it) +import Test.Spec.Assertions (expectError, shouldEqual) + +foreign import refEq :: forall a. a -> a -> Boolean + +spec :: Spec Unit +spec = describe "Pool" do + it "make" do + cfg <- liftEffect config + void $ liftEffect $ Pool.make cfg + around withPool do + it "idleCount, totalCount" \p -> do + a <- Pool.connect p + b <- Pool.connect p + c <- Pool.connect p + liftEffect $ Pool.release p a + liftEffect $ Pool.release p b + finally (liftEffect $ Pool.release p c) do + Pool.clientIdleCount p `shouldEqual` 2 + Pool.clientCount p `shouldEqual` 3 + Pool.clientIdleCount p `shouldEqual` 3 + Pool.clientCount p `shouldEqual` 3 + it "waitingCount" \p -> do + a <- Pool.connect p + b <- Pool.connect p + c <- Pool.connect p + dFiber <- forkAff $ Pool.connect p + let + rel = + do + void $ liftEffect $ traverse (Pool.release p) [ a, b, c ] + d <- joinFiber dFiber + liftEffect $ Pool.release p d + finally rel $ Pool.clientWaitingCount p `shouldEqual` 1 + describe "events" do + it "connect" \p -> do + expect <- forkAff $ void $ onceAff Pool.connectE p + c <- Pool.connect p + finally (liftEffect $ Pool.release p c) $ joinFiber expect + it "acquire" \p -> do + c <- Pool.connect p + liftEffect $ Pool.release p c + expect <- forkAff do + c'' <- onceAff Pool.acquireE p + refEq c c'' `shouldEqual` true + c' <- Pool.connect p + finally (liftEffect $ Pool.release p c') $ joinFiber expect + it "release" \p -> do + c <- Pool.connect p + expect <- forkAff do + c' <- onceAff Pool.releaseE p + refEq c c' `shouldEqual` true + liftEffect $ Pool.release p c + joinFiber expect + it "remove" \p -> do + c <- Pool.connect p + expect <- forkAff do + c' <- onceAff Pool.removeE p + refEq c c' `shouldEqual` true + liftEffect $ Pool.destroy p c + joinFiber expect + it "connect" \p -> do + c <- Pool.connect p + let rel = liftEffect $ Pool.release p c + finally rel $ shouldEqual [ 1 ] =<< Client.query "select 1" c + describe "destroy" do + it "throws on query after destroy" \p -> do + c <- Pool.connect p + liftEffect $ Pool.destroy p c + expectError $ Client.exec "select 1" c + it "different client yielded after destroy" \p -> do + a <- Pool.connect p + liftEffect $ Pool.destroy p a + b <- Pool.connect p + liftEffect $ Pool.destroy p b + refEq a b `shouldEqual` false + describe "release" do + it "allows reuse" \p -> do + a <- Pool.connect p + liftEffect $ Pool.release p a + b <- Pool.connect p + liftEffect $ Pool.release p b + refEq a b `shouldEqual` true + it "throws when invoked twice" \p -> do + c <- Pool.connect p + liftEffect $ Pool.release p c + expectError $ liftEffect $ Pool.release p c diff --git a/test/Test.Event.purs b/test/Test.Event.purs new file mode 100644 index 0000000..efcf6f7 --- /dev/null +++ b/test/Test.Event.purs @@ -0,0 +1,29 @@ +module Test.Event where + +import Prelude + +import Data.Either (Either(..)) +import Data.Profunctor (lcmap) +import Data.Tuple.Nested (type (/\), uncurry2, (/\)) +import Effect (Effect) +import Effect.Aff (Aff, makeAff) +import Node.EventEmitter (EventHandle(..)) +import Node.EventEmitter as EE + +class Curried a b | a -> b where + curried :: (b -> Effect Unit) -> a + +instance Curried (Effect Unit) Unit where + curried f = f unit + +instance Curried (a -> Effect Unit) a where + curried = identity + +instance Curried (a -> b -> Effect Unit) (a /\ b) where + curried f = \a b -> f $ a /\ b + +instance Curried (a -> b -> c -> Effect Unit) (a /\ b /\ c) where + curried f = \a b c -> f $ a /\ b /\ c + +onceAff :: forall psCb jsCb emitter r. Curried psCb r => EventHandle emitter psCb jsCb -> emitter -> Aff r +onceAff ev em = makeAff \res -> mempty <* EE.once ev (curried (res <<< Right)) em diff --git a/test/Test.Main.purs b/test/Test.Main.purs index c164797..efd60aa 100644 --- a/test/Test.Main.purs +++ b/test/Test.Main.purs @@ -22,6 +22,7 @@ import Node.Encoding (Encoding(..)) import Node.EventEmitter as Event import Test.Data.Postgres as Test.Data.Postgres import Test.Effect.Postgres.Client as Test.Effect.Postgres.Client +import Test.Effect.Postgres.Pool as Test.Effect.Postgres.Pool import Test.Spec.Reporter (specReporter) import Test.Spec.Runner (runSpec) @@ -62,3 +63,4 @@ main = launchAff_ do $ runSpec [ specReporter ] do Test.Data.Postgres.spec Test.Effect.Postgres.Client.spec + Test.Effect.Postgres.Pool.spec