diff --git a/README.md b/README.md index 6fef541..8930d02 100644 --- a/README.md +++ b/README.md @@ -20,7 +20,7 @@ import Prelude import Control.Monad.Except.Trans (ExceptT, runExceptT) import Data.Either (Either(..)) -import Database.PostgreSQL (Connection, DBHandle, defaultConfiguration, Pool, Query(Query), PGError) +import Database.PostgreSQL (Client, Connection, defaultConfiguration, Pool, Query(Query), PGError) import Database.PostgreSQL.PG (command, execute, query, withTransaction) as PG import Database.PostgreSQL.Pool (new) as Pool import Database.PostgreSQL.Row (Row0(Row0), Row3(Row3)) @@ -38,14 +38,14 @@ functions usually results in somthing like `Aff (Either PGError a)` which can be wrapped by user into `ExceptT` or any other custom monad stack. This base API is exposed by `PostgreSQL.Aff` module. To be honest we provide alternatives to functions in the `Database.PostgreSQL.PG` module that work on any stack `m` with `MonadError PGError m` and `MonadAff m`. -The module contains two functions `withConnection` and `withTransaction` that require additional parameter - a transformation from a custom monad stack to `Aff (Either PGError a)`. +The module contains two functions `withClient` and `withTransaction` that require additional parameter - a transformation from a custom monad stack to `Aff (Either PGError a)`. We are going to work with custom `AppM` type in this tutorial but please don't consider it as the only option if you encounter any troubles integrating it into your own app monad stack. ```purescript type AppM a = ExceptT PGError Aff a -withTransaction :: forall a. Pool -> (DBHandle -> AppM a) -> AppM a +withTransaction :: forall a. Pool -> (Connection -> AppM a) -> AppM a withTransaction p = PG.withTransaction runExceptT p ``` @@ -69,7 +69,7 @@ We can now create our temporary table which we are going to query in this exampl The last `Row0` value indicates that this `Query` doesn't take any additional parameters. Database quering functions like `execute` below can perform the action using pool (JS `Pool` instance) -or a connection (js `Client` instance) so they expect a value of type `type DBHandle = Either Pool Connection`. +or a connection (js `Client` instance) so they expect a value of type `type Connection = Either Pool Client`. ```purescript diff --git a/src/Database/PostgreSQL.purs b/src/Database/PostgreSQL.purs index 0c5e493..aa2188c 100644 --- a/src/Database/PostgreSQL.purs +++ b/src/Database/PostgreSQL.purs @@ -5,7 +5,7 @@ module Database.PostgreSQL , module Value ) where -import Database.PostgreSQL.Aff (Connection, ConnectResult, Query(..), PGError(..), PGErrorDetail) as Aff +import Database.PostgreSQL.Aff (Client, ConnectResult, Connection, Query(..), PGError(..), PGErrorDetail) as Aff import Database.PostgreSQL.Pool (Configuration, Database, parseURI, PGConnectionURI, new, Pool, defaultConfiguration) as Pool import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1(..), Row10(..), Row11(..), Row12(..), Row13(..), Row14(..), Row15(..), Row16(..), Row17(..), Row18(..), Row19(..), Row2(..), Row3(..), Row4(..), Row5(..), Row6(..), Row7(..), Row8(..), Row9(..), fromSQLRow, toSQLRow) as Row import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, instantFromString, instantToString, null, toSQLValue, unsafeIsBuffer) as Value diff --git a/src/Database/PostgreSQL/Aff.purs b/src/Database/PostgreSQL/Aff.purs index bdd43d3..bcf8e05 100644 --- a/src/Database/PostgreSQL/Aff.purs +++ b/src/Database/PostgreSQL/Aff.purs @@ -1,14 +1,14 @@ module Database.PostgreSQL.Aff - ( DBHandle + ( Connection , PGError(..) , PGErrorDetail - , Connection + , Client , ConnectResult , Query(..) , connect + , withClient + , withClientTransaction , withConnection - , withConnectionTransaction - , withDBHandle , withTransaction , command , execute @@ -17,7 +17,6 @@ module Database.PostgreSQL.Aff ) where import Prelude - import Control.Monad.Error.Class (catchError, throwError) import Data.Array (head) import Data.Bifunctor (lmap) @@ -43,7 +42,7 @@ import Foreign (Foreign) import Unsafe.Coerce (unsafeCoerce) -- | PostgreSQL connection. -foreign import data Connection :: Type +foreign import data Client :: Type -- | PostgreSQL query with parameter (`$1`, `$2`, …) and return types. newtype Query i o @@ -53,12 +52,12 @@ derive instance newtypeQuery :: Newtype (Query i o) _ -- | Run an action with a connection. The connection is released to the pool -- | when the action returns. -withConnection :: +withClient :: forall a. Pool -> - (Either PGError Connection -> Aff a) -> + (Either PGError Client -> Aff a) -> Aff a -withConnection p k = bracket (connect p) cleanup run +withClient p k = bracket (connect p) cleanup run where cleanup (Left _) = pure unit @@ -69,13 +68,13 @@ withConnection p k = bracket (connect p) cleanup run run (Right { connection }) = k (Right connection) -- | Trivial helper / shortcut which also wraps --- | the connection to provide `DBHandle`. -withDBHandle :: +-- | the connection to provide `Connection`. +withConnection :: forall a. Pool -> - (Either PGError DBHandle -> Aff a) -> + (Either PGError Connection -> Aff a) -> Aff a -withDBHandle p k = withConnection p (lcmap (map Right) k) +withConnection p k = withClient p (lcmap (map Right) k) connect :: Pool -> @@ -88,7 +87,7 @@ connect = } type ConnectResult - = { connection :: Connection + = { connection :: Client , done :: Effect Unit } @@ -104,12 +103,13 @@ foreign import ffiConnect :: withTransaction :: forall a. Pool -> - (DBHandle -> Aff a) -> + (Connection -> Aff a) -> Aff (Either PGError a) withTransaction pool action = - withConnection pool case _ of - Right conn -> withConnectionTransaction conn do - (action $ Right conn) + withClient pool case _ of + Right client -> + withClientTransaction client do + (action $ Right client) Left err → pure $ Left err -- | TODO: Outdated docs @@ -118,12 +118,12 @@ withTransaction pool action = -- | `PGError` or a JavaScript exception in the Aff context). If you want to -- | change the transaction mode, issue a separate `SET TRANSACTION` statement -- | within the transaction. -withConnectionTransaction :: +withClientTransaction :: forall a. - Connection -> + Client -> Aff a -> Aff (Either PGError a) -withConnectionTransaction conn action = +withClientTransaction client action = begin >>= case _ of Nothing -> do @@ -139,25 +139,26 @@ withConnectionTransaction conn action = Nothing -> pure (Right a) Just pgError -> pure (Left pgError) where - h = Right conn + h = Right client + begin = execute h (Query "BEGIN TRANSACTION") Row0 commit = execute h (Query "COMMIT TRANSACTION") Row0 rollback = execute h (Query "ROLLBACK TRANSACTION") Row0 -type DBHandle - = Either Pool Connection +type Connection + = Either Pool Client -- | APIs of the `Pool.query` and `Client.query` are the same. -- | We can dse this polyformphis to simplify ffi. -foreign import data UntaggedDBHandle ∷ Type +foreign import data UntaggedConnection ∷ Type -- | Execute a PostgreSQL query and discard its results. execute :: forall i o. (ToSQLRow i) => - DBHandle -> + Connection -> Query i o -> i -> Aff (Maybe PGError) @@ -168,7 +169,7 @@ query :: forall i o. ToSQLRow i => FromSQLRow o => - DBHandle -> + Connection -> Query i o -> i -> Aff (Either PGError (Array o)) @@ -182,7 +183,7 @@ scalar :: forall i o. ToSQLRow i => FromSQLValue o => - DBHandle -> + Connection -> Query i (Row1 o) -> i -> Aff (Either PGError (Maybe o)) @@ -194,7 +195,7 @@ scalar h sql values = query h sql values <#> map (head >>> map (case _ of Row1 a command :: forall i. ToSQLRow i => - DBHandle -> + Connection -> Query i Int -> i -> Aff (Either PGError Int) @@ -206,16 +207,16 @@ type QueryResult } unsafeQuery :: - DBHandle -> + Connection -> String -> Array Foreign -> Aff (Either PGError QueryResult) unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler c) s where - toUntaggedHandler ∷ DBHandle → UntaggedDBHandle + toUntaggedHandler ∷ Connection → UntaggedConnection toUntaggedHandler (Left pool) = unsafeCoerce pool - toUntaggedHandler (Right conn) = unsafeCoerce conn + toUntaggedHandler (Right client) = unsafeCoerce client p = { nullableLeft: toNullable <<< map Left <<< convertError @@ -226,13 +227,13 @@ foreign import ffiUnsafeQuery :: { nullableLeft :: Error -> Nullable (Either PGError QueryResult) , right :: QueryResult -> Either PGError QueryResult } -> - UntaggedDBHandle -> + UntaggedConnection -> String -> Array Foreign -> EffectFnAff (Either PGError QueryResult) data PGError - = ConnectionError String + = ClientError String | ConversionError String | InternalError PGErrorDetail | OperationalError PGErrorDetail @@ -335,7 +336,7 @@ convertError err = case toMaybe $ ffiSQLState err of if prefix "X" s then InternalError else - const $ ConnectionError s + const $ ClientError s prefix :: String -> String -> Boolean prefix p = maybe false (_ == 0) <<< String.indexOf (Pattern p) diff --git a/src/Database/PostgreSQL/PG.purs b/src/Database/PostgreSQL/PG.purs index af41cee..415dfb1 100644 --- a/src/Database/PostgreSQL/PG.purs +++ b/src/Database/PostgreSQL/PG.purs @@ -4,21 +4,20 @@ module Database.PostgreSQL.PG , onIntegrityError , query , scalar + , withClient + , withClientTransaction , withConnection - , withConnectionTransaction - , withDBHandle , withTransaction ) where import Prelude - import Control.Monad.Error.Class (catchError, throwError) import Control.Monad.Except (class MonadError) import Data.Either (Either(..), either) import Data.Maybe (Maybe, maybe) import Data.Profunctor (lcmap) -import Database.PostgreSQL.Aff (Connection, DBHandle, PGError(..), Query) -import Database.PostgreSQL.Aff (command, execute, query, scalar, withConnection, withConnectionTransaction, withTransaction) as Aff +import Database.PostgreSQL.Aff (Client, Connection, PGError(..), Query) +import Database.PostgreSQL.Aff (command, execute, query, scalar, withClient, withClientTransaction, withTransaction) as Aff import Database.PostgreSQL.Pool (Pool) import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1) import Database.PostgreSQL.Value (class FromSQLValue) @@ -33,6 +32,22 @@ hoistPG m = liftAff m >>= either throwError pure -- | Run an action with a connection. The connection is released to the pool -- | when the action returns. +withClient :: + ∀ a m. + MonadError PGError m => + MonadAff m => + (m a -> Aff (Either PGError a)) -> + Pool -> + (Client -> m a) -> + m a +withClient f p k = do + res <- + liftAff + $ Aff.withClient p case _ of + Right client -> f $ k client + Left pgErr -> pure $ Left pgErr + either throwError pure res + withConnection :: ∀ a m. MonadError PGError m => @@ -41,23 +56,7 @@ withConnection :: Pool -> (Connection -> m a) -> m a -withConnection f p k = do - res <- - liftAff - $ Aff.withConnection p case _ of - Right conn -> f $ k conn - Left pgErr -> pure $ Left pgErr - either throwError pure res - -withDBHandle :: - ∀ a m. - MonadError PGError m => - MonadAff m => - (m a -> Aff (Either PGError a)) -> - Pool -> - (DBHandle -> m a) -> - m a -withDBHandle f p k = withConnection f p (lcmap Right k) +withConnection f p k = withClient f p (lcmap Right k) -- | TODO: Update docs -- | Run an action within a transaction. The transaction is committed if the @@ -71,23 +70,25 @@ withTransaction :: MonadError PGError m => (m a -> Aff (Either PGError a)) -> Pool -> - (DBHandle -> m a) -> + (Connection -> m a) -> m a withTransaction f pool action = do - res <- liftAff $ Aff.withTransaction pool \conn -> do - (f (action conn)) + res <- + liftAff + $ Aff.withTransaction pool \client -> do + (f (action client)) either throwError pure $ join res -withConnectionTransaction :: +withClientTransaction :: ∀ a m. MonadAff m => MonadError PGError m => (m a -> Aff (Either PGError a)) -> - Connection -> + Client -> m a -> m a -withConnectionTransaction f conn action = do - res <- liftAff $ Aff.withConnectionTransaction conn (f action) +withClientTransaction f client action = do + res <- liftAff $ Aff.withClientTransaction client (f action) either throwError pure $ join res -- | Execute a PostgreSQL query and discard its results. @@ -96,7 +97,7 @@ execute :: ToSQLRow i => MonadError PGError m => MonadAff m => - DBHandle -> + Connection -> Query i o -> i -> m Unit @@ -111,7 +112,7 @@ query :: FromSQLRow o => MonadError PGError m => MonadAff m => - DBHandle -> + Connection -> Query i o -> i -> m (Array o) @@ -125,7 +126,7 @@ scalar :: FromSQLValue o => MonadError PGError m => MonadAff m => - DBHandle -> + Connection -> Query i (Row1 o) -> i -> m (Maybe o) @@ -139,7 +140,7 @@ command :: ToSQLRow i => MonadError PGError m => MonadAff m => - DBHandle -> + Connection -> Query i Int -> i -> m Int diff --git a/test/Main.purs b/test/Main.purs index 878854b..51dee89 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -3,7 +3,6 @@ module Test.Main ) where import Prelude - import Control.Monad.Error.Class (throwError, try) import Control.Monad.Except.Trans (runExceptT) import Control.Monad.Trans.Class (lift) @@ -22,9 +21,9 @@ import Data.Maybe (Maybe(..), fromJust) import Data.Newtype (unwrap) import Data.Tuple (Tuple(..)) import Data.Tuple.Nested ((/\)) -import Database.PostgreSQL (Configuration, Connection, DBHandle, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), PGConnectionURI, parseURI) +import Database.PostgreSQL (Configuration, Client, Connection, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), PGConnectionURI, parseURI) import Database.PostgreSQL.PG (command, execute, onIntegrityError, query, scalar) -import Database.PostgreSQL.PG (withConnection, withConnectionTransaction) as PG +import Database.PostgreSQL.PG (withClient, withClientTransaction) as PG import Database.PostgreSQL.Pool (new) as Pool import Effect (Effect) import Effect.Aff (Aff, error, launchAff) @@ -43,46 +42,44 @@ import Test.Unit as Test.Unit import Test.Unit.Assert (equal) import Test.Unit.Main (runTest) -withConnection :: forall a. Pool -> (Connection -> AppM a) -> AppM a -withConnection = PG.withConnection runExceptT - -withConnectionTransaction :: forall a. Connection -> AppM a -> AppM a -withConnectionTransaction = PG.withConnectionTransaction runExceptT +withClient :: forall a. Pool -> (Client -> AppM a) -> AppM a +withClient = PG.withClient runExceptT +withClientTransaction :: forall a. Client -> AppM a -> AppM a +withClientTransaction = PG.withClientTransaction runExceptT pgEqual :: forall a. Eq a => Show a => a -> a -> AppM Unit pgEqual a b = lift $ equal a b -withRollback - ∷ Connection - → AppM Unit - → AppM Unit -withRollback conn action = - begin *> action *> rollback - where - begin = execute (Right conn) (Query "BEGIN TRANSACTION") Row0 - rollback = execute (Right conn) (Query "ROLLBACK TRANSACTION") Row0 +withRollback ∷ + Client → + AppM Unit → + AppM Unit +withRollback client action = begin *> action *> rollback + where + begin = execute (Right client) (Query "BEGIN TRANSACTION") Row0 -test - ∷ DBHandle - → String - → AppM Unit - → TestSuite -test (Left pool) name action = - Test.Unit.test name $ checkPGErrors $ action -test (Right conn) name action = - Test.Unit.test name $ checkPGErrors $ withRollback conn action + rollback = execute (Right client) (Query "ROLLBACK TRANSACTION") Row0 -transactionTest - ∷ String - → AppM Unit - → TestSuite -transactionTest name action = - Test.Unit.test name $ checkPGErrors $ action +test ∷ + Connection → + String → + AppM Unit → + TestSuite +test (Left pool) name action = Test.Unit.test name $ checkPGErrors $ action + +test (Right client) name action = Test.Unit.test name $ checkPGErrors $ withRollback client action + +transactionTest ∷ + String → + AppM Unit → + TestSuite +transactionTest name action = Test.Unit.test name $ checkPGErrors $ action checkPGErrors :: AppM Unit -> Aff Unit checkPGErrors action = do - runExceptT action >>= case _ of + runExceptT action + >>= case _ of Left pgError -> Test.Unit.failure ("Unexpected PostgreSQL error occured:" <> unsafeStringify pgError) Right _ -> pure unit @@ -93,29 +90,30 @@ date ∷ Int → Int → Int → Date date y m d = unsafePartial $ fromJust $ canonicalDate <$> toEnum y <*> toEnum m <*> toEnum d jsdate_ ∷ Number → Number → Number → Number → Number → Number → Number → JSDate -jsdate_ year month day hour minute second millisecond = - jsdate { year, month, day, hour, minute, second, millisecond } +jsdate_ year month day hour minute second millisecond = jsdate { year, month, day, hour, minute, second, millisecond } noSuchDatabaseConfig :: Configuration → Configuration -noSuchDatabaseConfig config = - config { database = "non-existing" <> config.database } +noSuchDatabaseConfig config = config { database = "non-existing" <> config.database } cannotConnectConfig :: Configuration → Configuration cannotConnectConfig config = - config { host = Just "127.0.0.1" - , port = Just 45287 - } + config + { host = Just "127.0.0.1" + , port = Just 45287 + } main ∷ Effect Unit main = do - void $ launchAff do - -- Running guide from README - void $ runExceptT $ README.run - - config ← Config.load - pool ← liftEffect $ Pool.new config - - checkPGErrors $ execute (Left pool) (Query """ + void + $ launchAff do + -- Running guide from README + void $ runExceptT $ README.run + config ← Config.load + pool ← liftEffect $ Pool.new config + checkPGErrors + $ execute (Left pool) + ( Query + """ CREATE TEMPORARY TABLE foods ( name text NOT NULL, delicious boolean NOT NULL, @@ -133,266 +131,373 @@ main = do json json NOT NULL, jsonb jsonb NOT NULL ); - """) Row0 - - checkPGErrors $ withConnection pool \conn -> do - - liftEffect $ runTest $ do - suite "PostgreSQL client" $ do - let - testCount n = do - count <- scalar (Left pool) (Query """ + """ + ) + Row0 + checkPGErrors + $ withClient pool \client -> do + liftEffect $ runTest + $ do + suite "PostgreSQL client" + $ do + let + testCount n = do + count <- + scalar (Left pool) + ( Query + """ SELECT count(*) = $1 FROM foods - """) (Row1 n) - liftEffect <<< assert $ count == Just true - - transactionTest "transaction commit" do - withConnectionTransaction conn do - execute (Right conn) (Query """ + """ + ) + (Row1 n) + liftEffect <<< assert $ count == Just true + transactionTest "transaction commit" do + withClientTransaction client do + execute (Right client) + ( Query + """ INSERT INTO foods (name, delicious, price) VALUES ($1, $2, $3) - """) (Row3 "pork" true (D.fromString "8.30")) - testCount 1 - testCount 1 - execute (Right conn) (Query """ + """ + ) + (Row3 "pork" true (D.fromString "8.30")) + testCount 1 + testCount 1 + execute (Right client) + ( Query + """ DELETE FROM foods - """) Row0 - - transactionTest "transaction rollback on PostgreSQL error" $ do - _ <- try $ withConnectionTransaction conn do - execute (Right conn) (Query """ + """ + ) + Row0 + transactionTest "transaction rollback on PostgreSQL error" + $ do + _ <- + try + $ withClientTransaction client do + execute (Right client) + ( Query + """ INSERT INTO foods (name, delicious, price) VALUES ($1, $2, $3) - """) (Row3 "pork" true (D.fromString "8.30")) - testCount 1 - - -- invalid SQL query --> PGError is thrown - execute (Right conn) (Query "foo bar") Row0 - - -- transaction should've been rolled back - testCount 0 - - transactionTest "transaction rollback on JavaScript exception" $ do - result <- lift $ try $ runExceptT $ withConnectionTransaction conn do - execute (Right conn) (Query """ + """ + ) + (Row3 "pork" true (D.fromString "8.30")) + testCount 1 + -- invalid SQL query --> PGError is thrown + execute (Right client) (Query "foo bar") Row0 + -- transaction should've been rolled back + testCount 0 + transactionTest "transaction rollback on JavaScript exception" + $ do + result <- + lift $ try $ runExceptT + $ withClientTransaction client do + execute (Right client) + ( Query + """ INSERT INTO foods (name, delicious, price) VALUES ($1, $2, $3) - """) (Row3 "pork" true (D.fromString "8.30")) - testCount 1 - - -- throw a JavaScript error - lift $ throwError $ error "fail" - - -- make sure the JavaScript error was thrown - liftEffect $ case result of - Left jsErr -> assert (message jsErr == "fail") - Right _ -> assert false - - -- transaction should've been rolled back - testCount 0 - - let - handle = Right conn - - test handle "usage of rows represented by nested tuples" $ do - execute handle (Query """ + """ + ) + (Row3 "pork" true (D.fromString "8.30")) + testCount 1 + -- throw a JavaScript error + lift $ throwError $ error "fail" + -- make sure the JavaScript error was thrown + liftEffect + $ case result of + Left jsErr -> assert (message jsErr == "fail") + Right _ -> assert false + -- transaction should've been rolled back + testCount 0 + let + handle = Right client + test handle "usage of rows represented by nested tuples" + $ do + execute handle + ( Query + """ INSERT INTO foods (name, delicious, price) VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) - """) - ( ("pork" /\ true /\ (D.fromString "8.30")) - /\ ("sauerkraut" /\ false /\ (D.fromString "3.30")) - /\ ("rookworst" /\ true /\ (D.fromString "5.60"))) - names <- query handle (Query """ + """ + ) + ( ("pork" /\ true /\ (D.fromString "8.30")) + /\ ("sauerkraut" /\ false /\ (D.fromString "3.30")) + /\ ("rookworst" /\ true /\ (D.fromString "5.60")) + ) + names <- + query handle + ( Query + """ SELECT name, delicious FROM foods WHERE delicious ORDER BY name ASC - """) Row0 - liftEffect <<< assert $ names == ["pork" /\ true, "rookworst" /\ true] - - test handle "nested tuples as rows - just one element" $ do - let row = date 2010 2 31 /\ unit - execute handle (Query """ + """ + ) + Row0 + liftEffect <<< assert $ names == [ "pork" /\ true, "rookworst" /\ true ] + test handle "nested tuples as rows - just one element" + $ do + let + row = date 2010 2 31 /\ unit + execute handle + ( Query + """ INSERT INTO dates (date) VALUES ($1) - """) row - rows <- query handle (Query "SELECT date FROM dates") Row0 - liftEffect <<< assert $ rows == [row] - - let - insertFood = - execute handle (Query """ + """ + ) + row + rows <- query handle (Query "SELECT date FROM dates") Row0 + liftEffect <<< assert $ rows == [ row ] + let + insertFood = + execute handle + ( Query + """ INSERT INTO foods (name, delicious, price) VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) - """) (Row9 - "pork" true (D.fromString "8.30") - "sauerkraut" false (D.fromString "3.30") - "rookworst" true (D.fromString "5.60")) - - test handle "select column subset" $ do - insertFood - names <- query handle (Query """ + """ + ) + ( Row9 + "pork" + true + (D.fromString "8.30") + "sauerkraut" + false + (D.fromString "3.30") + "rookworst" + true + (D.fromString "5.60") + ) + test handle "select column subset" + $ do + insertFood + names <- + query handle + ( Query + """ SELECT name, delicious FROM foods WHERE delicious ORDER BY name ASC - """) Row0 - liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true] - - test handle "delete returning columns subset" $ do - insertFood - deleted <- query handle (Query """ + """ + ) + Row0 + liftEffect <<< assert $ names == [ Row2 "pork" true, Row2 "rookworst" true ] + test handle "delete returning columns subset" + $ do + insertFood + deleted <- + query handle + ( Query + """ DELETE FROM foods WHERE delicious RETURNING name, delicious - """) Row0 - liftEffect <<< assert $ deleted == [Row2 "pork" true, Row2 "rookworst" true] - - test handle "delete returning command tag value" $ do - insertFood - deleted <- command handle (Query """ + """ + ) + Row0 + liftEffect <<< assert $ deleted == [ Row2 "pork" true, Row2 "rookworst" true ] + test handle "delete returning command tag value" + $ do + insertFood + deleted <- + command handle + ( Query + """ DELETE FROM foods WHERE delicious - """) Row0 - liftEffect <<< assert $ deleted == 2 - - test handle "handling instant value" $ do - before <- liftEffect $ (unwrap <<< unInstant) <$> now - insertFood - added <- query handle (Query """ + """ + ) + Row0 + liftEffect <<< assert $ deleted == 2 + test handle "handling instant value" + $ do + before <- liftEffect $ (unwrap <<< unInstant) <$> now + insertFood + added <- + query handle + ( Query + """ SELECT added FROM foods - """) Row0 - after <- liftEffect $ (unwrap <<< unInstant) <$> now - -- | timestamps are fetched without milliseconds so we have to - -- | round before value down - liftEffect <<< assert $ all - (\(Row1 t) -> - ( unwrap $ unInstant t) >= (before - before % 1000.0) - && after >= (unwrap $ unInstant t)) - added - - test handle "handling decimal value" $ do - insertFood - sauerkrautPrice <- query handle (Query """ + """ + ) + Row0 + after <- liftEffect $ (unwrap <<< unInstant) <$> now + -- | timestamps are fetched without milliseconds so we have to + -- | round before value down + liftEffect <<< assert + $ all + ( \(Row1 t) -> + (unwrap $ unInstant t) >= (before - before % 1000.0) + && after + >= (unwrap $ unInstant t) + ) + added + test handle "handling decimal value" + $ do + insertFood + sauerkrautPrice <- + query handle + ( Query + """ SELECT price FROM foods WHERE NOT delicious - """) Row0 - liftEffect <<< assert $ sauerkrautPrice == [Row1 (D.fromString "3.30")] + """ + ) + Row0 + liftEffect <<< assert $ sauerkrautPrice == [ Row1 (D.fromString "3.30") ] + transactionTest "integrity error handling" + $ do + withRollback client do + result <- + onIntegrityError (pure "integrity error was handled") do + insertFood + insertFood + pure "integrity error was not handled" + liftEffect $ assert $ result == "integrity error was handled" + test handle "handling date value" + $ do + let + d1 = date 2010 2 31 - transactionTest "integrity error handling" $ do - withRollback conn do - result <- onIntegrityError (pure "integrity error was handled") do - insertFood - insertFood - pure "integrity error was not handled" - liftEffect $ assert $ result == "integrity error was handled" + d2 = date 2017 2 1 - test handle "handling date value" $ do - let - d1 = date 2010 2 31 - d2 = date 2017 2 1 - d3 = date 2020 6 31 - - execute handle (Query """ + d3 = date 2020 6 31 + execute handle + ( Query + """ INSERT INTO dates (date) VALUES ($1), ($2), ($3) - """) (Row3 d1 d2 d3) - - (dates :: Array (Row1 Date)) <- query handle (Query """ + """ + ) + (Row3 d1 d2 d3) + (dates :: Array (Row1 Date)) <- + query handle + ( Query + """ SELECT * FROM dates ORDER BY date ASC - """) Row0 - pgEqual 3 (length dates) - liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3]) - - test handle "handling Foreign.Object as json and jsonb" $ do - let jsonIn = Object.fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3] - let expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3] - - execute handle (Query """ + """ + ) + Row0 + pgEqual 3 (length dates) + liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [ d1, d2, d3 ]) + test handle "handling Foreign.Object as json and jsonb" + $ do + let + jsonIn = Object.fromFoldable [ Tuple "a" 1, Tuple "a" 2, Tuple "2" 3 ] + let + expected = Object.fromFoldable [ Tuple "a" 2, Tuple "2" 3 ] + execute handle + ( Query + """ INSERT INTO jsons (json, jsonb) VALUES ($1, $2) - """) (Row2 jsonIn jsonIn) - - (js ∷ Array (Row2 (Object Int) (Object Int))) <- query handle (Query """SELECT * FROM JSONS""") Row0 - liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js - - test handle "handling Argonaut.Json as json and jsonb for an object" $ do - let input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ]) - - execute handle (Query """ + """ + ) + (Row2 jsonIn jsonIn) + (js ∷ Array (Row2 (Object Int) (Object Int))) <- query handle (Query """SELECT * FROM JSONS""") Row0 + liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js + test handle "handling Argonaut.Json as json and jsonb for an object" + $ do + let + input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ]) + execute handle + ( Query + """ INSERT INTO jsons (json, jsonb) VALUES ($1, $2) - """) (Row2 input input) - - (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0 - liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js - - test handle "handling Argonaut.Json as json and jsonb for an array" $ do - let input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])] - - execute handle (Query """ + """ + ) + (Row2 input input) + (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0 + liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js + test handle "handling Argonaut.Json as json and jsonb for an array" + $ do + let + input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ]) ] + execute handle + ( Query + """ INSERT INTO jsons (json, jsonb) VALUES ($1, $2) - """) (Row2 input input) + """ + ) + (Row2 input input) + (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0 + liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js + test handle "handling jsdate value" + $ do + let + jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0 - (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0 - liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js + jsd2 = jsdate_ 2017.0 2.0 1.0 12.0 59.0 42.0 999.0 - test handle "handling jsdate value" $ do - let - jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0 - jsd2 = jsdate_ 2017.0 2.0 1.0 12.0 59.0 42.0 999.0 - jsd3 = jsdate_ 2020.0 6.0 31.0 23.0 3.0 59.0 333.0 - - execute handle (Query """ + jsd3 = jsdate_ 2020.0 6.0 31.0 23.0 3.0 59.0 333.0 + execute handle + ( Query + """ INSERT INTO timestamps (timestamp) VALUES ($1), ($2), ($3) - """) (Row3 jsd1 jsd2 jsd3) - - (timestamps :: Array (Row1 JSDate)) <- query handle (Query """ + """ + ) + (Row3 jsd1 jsd2 jsd3) + (timestamps :: Array (Row1 JSDate)) <- + query handle + ( Query + """ SELECT * FROM timestamps ORDER BY timestamp ASC - """) Row0 - pgEqual 3 (length timestamps) - liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip timestamps [jsd1, jsd2, jsd3]) + """ + ) + Row0 + pgEqual 3 (length timestamps) + liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip timestamps [ jsd1, jsd2, jsd3 ]) + suite "PostgreSQL connection errors" + $ do + let + doNothing _ = pure unit + Test.Unit.test "connection refused" do + testPool <- liftEffect $ Pool.new (cannotConnectConfig config) + runExceptT (withClient testPool doNothing) + >>= case _ of + Left (ClientError cause) -> equal cause "ECONNREFUSED" + _ -> Test.Unit.failure "foo" + Test.Unit.test "no such database" do + testPool <- liftEffect $ Pool.new (noSuchDatabaseConfig config) + runExceptT (withClient testPool doNothing) + >>= case _ of + Left (ProgrammingError { code, message }) -> equal code "3D000" + _ -> Test.Unit.failure "PostgreSQL error was expected" + Test.Unit.test "get pool configuration from postgres uri" do + equal (parseURI validUriToPoolConfigs.uri) (Just validUriToPoolConfigs.poolConfig) + equal (parseURI notValidConnUri) Nothing - suite "PostgreSQL connection errors" $ do - let doNothing _ = pure unit - - Test.Unit.test "connection refused" do - testPool <- liftEffect $ Pool.new (cannotConnectConfig config) - runExceptT (withConnection testPool doNothing) >>= case _ of - Left (ConnectionError cause) -> equal cause "ECONNREFUSED" - _ -> Test.Unit.failure "foo" - - Test.Unit.test "no such database" do - testPool <- liftEffect $ Pool.new (noSuchDatabaseConfig config) - runExceptT (withConnection testPool doNothing) >>= case _ of - Left (ProgrammingError { code, message }) -> equal code "3D000" - _ -> Test.Unit.failure "PostgreSQL error was expected" - - Test.Unit.test "get pool configuration from postgres uri" do - equal (parseURI validUriToPoolConfigs.uri) (Just validUriToPoolConfigs.poolConfig) - equal (parseURI notValidConnUri) Nothing - -validUriToPoolConfigs :: { uri :: PGConnectionURI - , poolConfig :: Configuration } -validUriToPoolConfigs = { uri: "postgres://urllgqrivcyako:c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo" - , poolConfig: { database: "e7cecg4nirunpo" - , host: Just "ec2-79-124-25-231.eu-west-1.compute.amazonaws.com" - , idleTimeoutMillis: Nothing - , max: Nothing - , password: Just "c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969" - , port: Just 5432 - , user: Just "urllgqrivcyako" - } - } +validUriToPoolConfigs :: + { uri :: PGConnectionURI + , poolConfig :: Configuration + } +validUriToPoolConfigs = + { uri: "postgres://urllgqrivcyako:c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo" + , poolConfig: + { database: "e7cecg4nirunpo" + , host: Just "ec2-79-124-25-231.eu-west-1.compute.amazonaws.com" + , idleTimeoutMillis: Nothing + , max: Nothing + , password: Just "c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969" + , port: Just 5432 + , user: Just "urllgqrivcyako" + } + } notValidConnUri :: PGConnectionURI notValidConnUri = "postgres://urllgqrivcyakoc52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo"