thunderstrike/purescript-postgresql-client
thunderstrike/purescript-postgresql-client
2
0
Fork 0
generated from tpl/purs
Code Issues Pull Requests Packages Projects Releases Wiki Activity

s/Connection/Client/ + s/DBHandle/Connection/

Browse Source
This commit is contained in:
Tomasz Rybarczyk 2020-11-10 17:13:01 +01:00
parent 76a5b41f3e
commit 4c738fe72f
5 changed files with 434 additions and 327 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
README.md
View File

@ -20,7 +20,7 @@ import Prelude
import Control.Monad.Except.Trans (ExceptT, runExceptT) import Control.Monad.Except.Trans (ExceptT, runExceptT)
import Data.Either (Either(..)) 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.PG (command, execute, query, withTransaction) as PG
import Database.PostgreSQL.Pool (new) as Pool import Database.PostgreSQL.Pool (new) as Pool
import Database.PostgreSQL.Row (Row0(Row0), Row3(Row3)) 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 wrapped by user into `ExceptT` or any other custom monad stack. This base API is exposed by
`PostgreSQL.Aff` module. `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`. 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 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. if you encounter any troubles integrating it into your own app monad stack.
```purescript ```purescript
type AppM a = ExceptT PGError Aff a 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 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. 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) 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 ```purescript

2
src/Database/PostgreSQL.purs
View File

@ -5,7 +5,7 @@ module Database.PostgreSQL
, module Value , module Value
) where ) 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.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.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 import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, instantFromString, instantToString, null, toSQLValue, unsafeIsBuffer) as Value

71
src/Database/PostgreSQL/Aff.purs
View File

@ -1,14 +1,14 @@
module Database.PostgreSQL.Aff module Database.PostgreSQL.Aff
( DBHandle ( Connection
, PGError(..) , PGError(..)
, PGErrorDetail , PGErrorDetail
, Connection , Client
, ConnectResult , ConnectResult
, Query(..) , Query(..)
, connect , connect
, withClient
, withClientTransaction
, withConnection , withConnection
, withConnectionTransaction
, withDBHandle
, withTransaction , withTransaction
, command , command
, execute , execute
@ -17,7 +17,6 @@ module Database.PostgreSQL.Aff
) where ) where
import Prelude import Prelude
import Control.Monad.Error.Class (catchError, throwError) import Control.Monad.Error.Class (catchError, throwError)
import Data.Array (head) import Data.Array (head)
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
@ -43,7 +42,7 @@ import Foreign (Foreign)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
-- | PostgreSQL connection. -- | PostgreSQL connection.
foreign import data Connection :: Type foreign import data Client :: Type
-- | PostgreSQL query with parameter (`$1`, `$2`, …) and return types. -- | PostgreSQL query with parameter (`$1`, `$2`, …) and return types.
newtype Query i o 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 -- | Run an action with a connection. The connection is released to the pool
-- | when the action returns. -- | when the action returns.
withConnection :: withClient ::
forall a. forall a.
Pool -> Pool ->
(Either PGError Connection -> Aff a) -> (Either PGError Client -> Aff a) ->
Aff a Aff a
withConnection p k = bracket (connect p) cleanup run withClient p k = bracket (connect p) cleanup run
where where
cleanup (Left _) = pure unit cleanup (Left _) = pure unit
@ -69,13 +68,13 @@ withConnection p k = bracket (connect p) cleanup run
run (Right { connection }) = k (Right connection) run (Right { connection }) = k (Right connection)
-- | Trivial helper / shortcut which also wraps -- | Trivial helper / shortcut which also wraps
-- | the connection to provide `DBHandle`. -- | the connection to provide `Connection`.
withDBHandle :: withConnection ::
forall a. forall a.
Pool -> Pool ->
(Either PGError DBHandle -> Aff a) -> (Either PGError Connection -> Aff a) ->
Aff a Aff a
withDBHandle p k = withConnection p (lcmap (map Right) k) withConnection p k = withClient p (lcmap (map Right) k)
connect :: connect ::
Pool -> Pool ->
@ -88,7 +87,7 @@ connect =
} }
type ConnectResult type ConnectResult
= { connection :: Connection = { connection :: Client
, done :: Effect Unit , done :: Effect Unit
} }
@ -104,12 +103,13 @@ foreign import ffiConnect ::
withTransaction :: withTransaction ::
forall a. forall a.
Pool -> Pool ->
(DBHandle -> Aff a) -> (Connection -> Aff a) ->
Aff (Either PGError a) Aff (Either PGError a)
withTransaction pool action = withTransaction pool action =
withConnection pool case _ of withClient pool case _ of
Right conn -> withConnectionTransaction conn do Right client ->
(action $ Right conn) withClientTransaction client do
(action $ Right client)
Left err → pure $ Left err Left err → pure $ Left err
-- | TODO: Outdated docs -- | TODO: Outdated docs
@ -118,12 +118,12 @@ withTransaction pool action =
-- | `PGError` or a JavaScript exception in the Aff context). If you want to -- | `PGError` or a JavaScript exception in the Aff context). If you want to
-- | change the transaction mode, issue a separate `SET TRANSACTION` statement -- | change the transaction mode, issue a separate `SET TRANSACTION` statement
-- | within the transaction. -- | within the transaction.
withConnectionTransaction :: withClientTransaction ::
forall a. forall a.
Connection -> Client ->
Aff a -> Aff a ->
Aff (Either PGError a) Aff (Either PGError a)
withConnectionTransaction conn action = withClientTransaction client action =
begin begin
>>= case _ of >>= case _ of
Nothing -> do Nothing -> do
@ -139,25 +139,26 @@ withConnectionTransaction conn action =
Nothing -> pure (Right a) Nothing -> pure (Right a)
Just pgError -> pure (Left pgError) Just pgError -> pure (Left pgError)
where where
h = Right conn h = Right client
begin = execute h (Query "BEGIN TRANSACTION") Row0 begin = execute h (Query "BEGIN TRANSACTION") Row0
commit = execute h (Query "COMMIT TRANSACTION") Row0 commit = execute h (Query "COMMIT TRANSACTION") Row0
rollback = execute h (Query "ROLLBACK TRANSACTION") Row0 rollback = execute h (Query "ROLLBACK TRANSACTION") Row0
type DBHandle type Connection
= Either Pool Connection = Either Pool Client
-- | APIs of the `Pool.query` and `Client.query` are the same. -- | APIs of the `Pool.query` and `Client.query` are the same.
-- | We can dse this polyformphis to simplify ffi. -- | 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 a PostgreSQL query and discard its results.
execute :: execute ::
forall i o. forall i o.
(ToSQLRow i) => (ToSQLRow i) =>
DBHandle -> Connection ->
Query i o -> Query i o ->
i -> i ->
Aff (Maybe PGError) Aff (Maybe PGError)
@ -168,7 +169,7 @@ query ::
forall i o. forall i o.
ToSQLRow i => ToSQLRow i =>
FromSQLRow o => FromSQLRow o =>
DBHandle -> Connection ->
Query i o -> Query i o ->
i -> i ->
Aff (Either PGError (Array o)) Aff (Either PGError (Array o))
@ -182,7 +183,7 @@ scalar ::
forall i o. forall i o.
ToSQLRow i => ToSQLRow i =>
FromSQLValue o => FromSQLValue o =>
DBHandle -> Connection ->
Query i (Row1 o) -> Query i (Row1 o) ->
i -> i ->
Aff (Either PGError (Maybe o)) 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 :: command ::
forall i. forall i.
ToSQLRow i => ToSQLRow i =>
DBHandle -> Connection ->
Query i Int -> Query i Int ->
i -> i ->
Aff (Either PGError Int) Aff (Either PGError Int)
@ -206,16 +207,16 @@ type QueryResult
} }
unsafeQuery :: unsafeQuery ::
DBHandle -> Connection ->
String -> String ->
Array Foreign -> Array Foreign ->
Aff (Either PGError QueryResult) Aff (Either PGError QueryResult)
unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler c) s unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler c) s
where where
toUntaggedHandler ∷ DBHandle → UntaggedDBHandle toUntaggedHandler ∷ Connection → UntaggedConnection
toUntaggedHandler (Left pool) = unsafeCoerce pool toUntaggedHandler (Left pool) = unsafeCoerce pool
toUntaggedHandler (Right conn) = unsafeCoerce conn toUntaggedHandler (Right client) = unsafeCoerce client
p = p =
{ nullableLeft: toNullable <<< map Left <<< convertError { nullableLeft: toNullable <<< map Left <<< convertError
@ -226,13 +227,13 @@ foreign import ffiUnsafeQuery ::
{ nullableLeft :: Error -> Nullable (Either PGError QueryResult) { nullableLeft :: Error -> Nullable (Either PGError QueryResult)
, right :: QueryResult -> Either PGError QueryResult , right :: QueryResult -> Either PGError QueryResult
} -> } ->
UntaggedDBHandle -> UntaggedConnection ->
String -> String ->
Array Foreign -> Array Foreign ->
EffectFnAff (Either PGError QueryResult) EffectFnAff (Either PGError QueryResult)
data PGError data PGError
= ConnectionError String = ClientError String
| ConversionError String | ConversionError String
| InternalError PGErrorDetail | InternalError PGErrorDetail
| OperationalError PGErrorDetail | OperationalError PGErrorDetail
@ -335,7 +336,7 @@ convertError err = case toMaybe $ ffiSQLState err of
if prefix "X" s then if prefix "X" s then
InternalError InternalError
else else
const $ ConnectionError s const $ ClientError s
prefix :: String -> String -> Boolean prefix :: String -> String -> Boolean
prefix p = maybe false (_ == 0) <<< String.indexOf (Pattern p) prefix p = maybe false (_ == 0) <<< String.indexOf (Pattern p)

67
src/Database/PostgreSQL/PG.purs
View File

@ -4,21 +4,20 @@ module Database.PostgreSQL.PG
, onIntegrityError , onIntegrityError
, query , query
, scalar , scalar
, withClient
, withClientTransaction
, withConnection , withConnection
, withConnectionTransaction
, withDBHandle
, withTransaction , withTransaction
) where ) where
import Prelude import Prelude
import Control.Monad.Error.Class (catchError, throwError) import Control.Monad.Error.Class (catchError, throwError)
import Control.Monad.Except (class MonadError) import Control.Monad.Except (class MonadError)
import Data.Either (Either(..), either) import Data.Either (Either(..), either)
import Data.Maybe (Maybe, maybe) import Data.Maybe (Maybe, maybe)
import Data.Profunctor (lcmap) import Data.Profunctor (lcmap)
import Database.PostgreSQL.Aff (Connection, DBHandle, PGError(..), Query) import Database.PostgreSQL.Aff (Client, Connection, PGError(..), Query)
import Database.PostgreSQL.Aff (command, execute, query, scalar, withConnection, withConnectionTransaction, withTransaction) as Aff import Database.PostgreSQL.Aff (command, execute, query, scalar, withClient, withClientTransaction, withTransaction) as Aff
import Database.PostgreSQL.Pool (Pool) import Database.PostgreSQL.Pool (Pool)
import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1) import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1)
import Database.PostgreSQL.Value (class FromSQLValue) 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 -- | Run an action with a connection. The connection is released to the pool
-- | when the action returns. -- | 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 :: withConnection ::
∀ a m. ∀ a m.
MonadError PGError m => MonadError PGError m =>
@ -41,23 +56,7 @@ withConnection ::
Pool -> Pool ->
(Connection -> m a) -> (Connection -> m a) ->
m a m a
withConnection f p k = do withConnection f p k = withClient f p (lcmap Right k)
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)
-- | TODO: Update docs -- | TODO: Update docs
-- | Run an action within a transaction. The transaction is committed if the -- | Run an action within a transaction. The transaction is committed if the
@ -71,23 +70,25 @@ withTransaction ::
MonadError PGError m => MonadError PGError m =>
(m a -> Aff (Either PGError a)) -> (m a -> Aff (Either PGError a)) ->
Pool -> Pool ->
(DBHandle -> m a) -> (Connection -> m a) ->
m a m a
withTransaction f pool action = do withTransaction f pool action = do
res <- liftAff $ Aff.withTransaction pool \conn -> do res <-
(f (action conn)) liftAff
$ Aff.withTransaction pool \client -> do
(f (action client))
either throwError pure $ join res either throwError pure $ join res
withConnectionTransaction :: withClientTransaction ::
∀ a m. ∀ a m.
MonadAff m => MonadAff m =>
MonadError PGError m => MonadError PGError m =>
(m a -> Aff (Either PGError a)) -> (m a -> Aff (Either PGError a)) ->
Connection -> Client ->
m a -> m a ->
m a m a
withConnectionTransaction f conn action = do withClientTransaction f client action = do
res <- liftAff $ Aff.withConnectionTransaction conn (f action) res <- liftAff $ Aff.withClientTransaction client (f action)
either throwError pure $ join res either throwError pure $ join res
-- | Execute a PostgreSQL query and discard its results. -- | Execute a PostgreSQL query and discard its results.
@ -96,7 +97,7 @@ execute ::
ToSQLRow i => ToSQLRow i =>
MonadError PGError m => MonadError PGError m =>
MonadAff m => MonadAff m =>
DBHandle -> Connection ->
Query i o -> Query i o ->
i -> i ->
m Unit m Unit
@ -111,7 +112,7 @@ query ::
FromSQLRow o => FromSQLRow o =>
MonadError PGError m => MonadError PGError m =>
MonadAff m => MonadAff m =>
DBHandle -> Connection ->
Query i o -> Query i o ->
i -> i ->
m (Array o) m (Array o)
@ -125,7 +126,7 @@ scalar ::
FromSQLValue o => FromSQLValue o =>
MonadError PGError m => MonadError PGError m =>
MonadAff m => MonadAff m =>
DBHandle -> Connection ->
Query i (Row1 o) -> Query i (Row1 o) ->
i -> i ->
m (Maybe o) m (Maybe o)
@ -139,7 +140,7 @@ command ::
ToSQLRow i => ToSQLRow i =>
MonadError PGError m => MonadError PGError m =>
MonadAff m => MonadAff m =>
DBHandle -> Connection ->
Query i Int -> Query i Int ->
i -> i ->
m Int m Int

613
test/Main.purs
View File

@ -3,7 +3,6 @@ module Test.Main
) where ) where
import Prelude import Prelude
import Control.Monad.Error.Class (throwError, try) import Control.Monad.Error.Class (throwError, try)
import Control.Monad.Except.Trans (runExceptT) import Control.Monad.Except.Trans (runExceptT)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
@ -22,9 +21,9 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (unwrap) import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) 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 (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 Database.PostgreSQL.Pool (new) as Pool
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, error, launchAff) import Effect.Aff (Aff, error, launchAff)
@ -43,46 +42,44 @@ import Test.Unit as Test.Unit
import Test.Unit.Assert (equal) import Test.Unit.Assert (equal)
import Test.Unit.Main (runTest) import Test.Unit.Main (runTest)
withConnection :: forall a. Pool -> (Connection -> AppM a) -> AppM a withClient :: forall a. Pool -> (Client -> AppM a) -> AppM a
withConnection = PG.withConnection runExceptT withClient = PG.withClient runExceptT
withConnectionTransaction :: forall a. Connection -> AppM a -> AppM a
withConnectionTransaction = PG.withConnectionTransaction 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 :: forall a. Eq a => Show a => a -> a -> AppM Unit
pgEqual a b = lift $ equal a b pgEqual a b = lift $ equal a b
withRollback withRollback ∷
∷ Connection Client →
→ AppM Unit AppM Unit →
→ AppM Unit AppM Unit
withRollback conn action = withRollback client action = begin *> action *> rollback
begin *> action *> rollback where
where begin = execute (Right client) (Query "BEGIN TRANSACTION") Row0
begin = execute (Right conn) (Query "BEGIN TRANSACTION") Row0
rollback = execute (Right conn) (Query "ROLLBACK TRANSACTION") Row0
test rollback = execute (Right client) (Query "ROLLBACK TRANSACTION") Row0
∷ 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
transactionTest test ∷
∷ String Connection →
→ AppM Unit String →
→ TestSuite AppM Unit →
transactionTest name action = TestSuite
Test.Unit.test name $ checkPGErrors $ action 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 :: AppM Unit -> Aff Unit
checkPGErrors action = do checkPGErrors action = do
runExceptT action >>= case _ of runExceptT action
>>= case _ of
Left pgError -> Test.Unit.failure ("Unexpected PostgreSQL error occured:" <> unsafeStringify pgError) Left pgError -> Test.Unit.failure ("Unexpected PostgreSQL error occured:" <> unsafeStringify pgError)
Right _ -> pure unit 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 date y m d = unsafePartial $ fromJust $ canonicalDate <$> toEnum y <*> toEnum m <*> toEnum d
jsdate_ ∷ Number → Number → Number → Number → Number → Number → Number → JSDate 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 :: Configuration → Configuration
noSuchDatabaseConfig config = noSuchDatabaseConfig config = config { database = "non-existing" <> config.database }
config { database = "non-existing" <> config.database }
cannotConnectConfig :: Configuration → Configuration cannotConnectConfig :: Configuration → Configuration
cannotConnectConfig config = cannotConnectConfig config =
config { host = Just "127.0.0.1" config
, port = Just 45287 { host = Just "127.0.0.1"
} , port = Just 45287
}
main ∷ Effect Unit main ∷ Effect Unit
main = do main = do
void $ launchAff do void
-- Running guide from README $ launchAff do
void $ runExceptT $ README.run -- Running guide from README
void $ runExceptT $ README.run
config ← Config.load config ← Config.load
pool ← liftEffect $ Pool.new config pool ← liftEffect $ Pool.new config
checkPGErrors
checkPGErrors $ execute (Left pool) (Query """ $ execute (Left pool)
( Query
"""
CREATE TEMPORARY TABLE foods ( CREATE TEMPORARY TABLE foods (
name text NOT NULL, name text NOT NULL,
delicious boolean NOT NULL, delicious boolean NOT NULL,
@ -133,266 +131,373 @@ main = do
json json NOT NULL, json json NOT NULL,
jsonb jsonb NOT NULL jsonb jsonb NOT NULL
); );
""") Row0 """
)
checkPGErrors $ withConnection pool \conn -> do Row0
checkPGErrors
liftEffect $ runTest $ do $ withClient pool \client -> do
suite "PostgreSQL client" $ do liftEffect $ runTest
let $ do
testCount n = do suite "PostgreSQL client"
count <- scalar (Left pool) (Query """ $ do
let
testCount n = do
count <-
scalar (Left pool)
( Query
"""
SELECT count(*) = $1 SELECT count(*) = $1
FROM foods FROM foods
""") (Row1 n) """
liftEffect <<< assert $ count == Just true )
(Row1 n)
transactionTest "transaction commit" do liftEffect <<< assert $ count == Just true
withConnectionTransaction conn do transactionTest "transaction commit" do
execute (Right conn) (Query """ withClientTransaction client do
execute (Right client)
( Query
"""
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3) VALUES ($1, $2, $3)
""") (Row3 "pork" true (D.fromString "8.30")) """
testCount 1 )
testCount 1 (Row3 "pork" true (D.fromString "8.30"))
execute (Right conn) (Query """ testCount 1
testCount 1
execute (Right client)
( Query
"""
DELETE FROM foods DELETE FROM foods
""") Row0 """
)
transactionTest "transaction rollback on PostgreSQL error" $ do Row0
_ <- try $ withConnectionTransaction conn do transactionTest "transaction rollback on PostgreSQL error"
execute (Right conn) (Query """ $ do
_ <-
try
$ withClientTransaction client do
execute (Right client)
( Query
"""
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3) VALUES ($1, $2, $3)
""") (Row3 "pork" true (D.fromString "8.30")) """
testCount 1 )
(Row3 "pork" true (D.fromString "8.30"))
-- invalid SQL query --> PGError is thrown testCount 1
execute (Right conn) (Query "foo bar") Row0 -- invalid SQL query --> PGError is thrown
execute (Right client) (Query "foo bar") Row0
-- transaction should've been rolled back -- transaction should've been rolled back
testCount 0 testCount 0
transactionTest "transaction rollback on JavaScript exception"
transactionTest "transaction rollback on JavaScript exception" $ do $ do
result <- lift $ try $ runExceptT $ withConnectionTransaction conn do result <-
execute (Right conn) (Query """ lift $ try $ runExceptT
$ withClientTransaction client do
execute (Right client)
( Query
"""
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3) VALUES ($1, $2, $3)
""") (Row3 "pork" true (D.fromString "8.30")) """
testCount 1 )
(Row3 "pork" true (D.fromString "8.30"))
-- throw a JavaScript error testCount 1
lift $ throwError $ error "fail" -- throw a JavaScript error
lift $ throwError $ error "fail"
-- make sure the JavaScript error was thrown -- make sure the JavaScript error was thrown
liftEffect $ case result of liftEffect
Left jsErr -> assert (message jsErr == "fail") $ case result of
Right _ -> assert false Left jsErr -> assert (message jsErr == "fail")
Right _ -> assert false
-- transaction should've been rolled back -- transaction should've been rolled back
testCount 0 testCount 0
let
let handle = Right client
handle = Right conn test handle "usage of rows represented by nested tuples"
$ do
test handle "usage of rows represented by nested tuples" $ do execute handle
execute handle (Query """ ( Query
"""
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
""") """
( ("pork" /\ true /\ (D.fromString "8.30")) )
/\ ("sauerkraut" /\ false /\ (D.fromString "3.30")) ( ("pork" /\ true /\ (D.fromString "8.30"))
/\ ("rookworst" /\ true /\ (D.fromString "5.60"))) /\ ("sauerkraut" /\ false /\ (D.fromString "3.30"))
names <- query handle (Query """ /\ ("rookworst" /\ true /\ (D.fromString "5.60"))
)
names <-
query handle
( Query
"""
SELECT name, delicious SELECT name, delicious
FROM foods FROM foods
WHERE delicious WHERE delicious
ORDER BY name ASC ORDER BY name ASC
""") Row0 """
liftEffect <<< assert $ names == ["pork" /\ true, "rookworst" /\ true] )
Row0
test handle "nested tuples as rows - just one element" $ do liftEffect <<< assert $ names == [ "pork" /\ true, "rookworst" /\ true ]
let row = date 2010 2 31 /\ unit test handle "nested tuples as rows - just one element"
execute handle (Query """ $ do
let
row = date 2010 2 31 /\ unit
execute handle
( Query
"""
INSERT INTO dates (date) INSERT INTO dates (date)
VALUES ($1) VALUES ($1)
""") row """
rows <- query handle (Query "SELECT date FROM dates") Row0 )
liftEffect <<< assert $ rows == [row] row
rows <- query handle (Query "SELECT date FROM dates") Row0
let liftEffect <<< assert $ rows == [ row ]
insertFood = let
execute handle (Query """ insertFood =
execute handle
( Query
"""
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
""") (Row9 """
"pork" true (D.fromString "8.30") )
"sauerkraut" false (D.fromString "3.30") ( Row9
"rookworst" true (D.fromString "5.60")) "pork"
true
test handle "select column subset" $ do (D.fromString "8.30")
insertFood "sauerkraut"
names <- query handle (Query """ 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 SELECT name, delicious
FROM foods FROM foods
WHERE delicious WHERE delicious
ORDER BY name ASC ORDER BY name ASC
""") Row0 """
liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true] )
Row0
test handle "delete returning columns subset" $ do liftEffect <<< assert $ names == [ Row2 "pork" true, Row2 "rookworst" true ]
insertFood test handle "delete returning columns subset"
deleted <- query handle (Query """ $ do
insertFood
deleted <-
query handle
( Query
"""
DELETE FROM foods DELETE FROM foods
WHERE delicious WHERE delicious
RETURNING name, delicious RETURNING name, delicious
""") Row0 """
liftEffect <<< assert $ deleted == [Row2 "pork" true, Row2 "rookworst" true] )
Row0
test handle "delete returning command tag value" $ do liftEffect <<< assert $ deleted == [ Row2 "pork" true, Row2 "rookworst" true ]
insertFood test handle "delete returning command tag value"
deleted <- command handle (Query """ $ do
insertFood
deleted <-
command handle
( Query
"""
DELETE FROM foods DELETE FROM foods
WHERE delicious WHERE delicious
""") Row0 """
liftEffect <<< assert $ deleted == 2 )
Row0
test handle "handling instant value" $ do liftEffect <<< assert $ deleted == 2
before <- liftEffect $ (unwrap <<< unInstant) <$> now test handle "handling instant value"
insertFood $ do
added <- query handle (Query """ before <- liftEffect $ (unwrap <<< unInstant) <$> now
insertFood
added <-
query handle
( Query
"""
SELECT added SELECT added
FROM foods FROM foods
""") Row0 """
after <- liftEffect $ (unwrap <<< unInstant) <$> now )
-- | timestamps are fetched without milliseconds so we have to Row0
-- | round before value down after <- liftEffect $ (unwrap <<< unInstant) <$> now
liftEffect <<< assert $ all -- | timestamps are fetched without milliseconds so we have to
(\(Row1 t) -> -- | round before value down
( unwrap $ unInstant t) >= (before - before % 1000.0) liftEffect <<< assert
&& after >= (unwrap $ unInstant t)) $ all
added ( \(Row1 t) ->
(unwrap $ unInstant t) >= (before - before % 1000.0)
test handle "handling decimal value" $ do && after
insertFood >= (unwrap $ unInstant t)
sauerkrautPrice <- query handle (Query """ )
added
test handle "handling decimal value"
$ do
insertFood
sauerkrautPrice <-
query handle
( Query
"""
SELECT price SELECT price
FROM foods FROM foods
WHERE NOT delicious 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 d2 = date 2017 2 1
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"
test handle "handling date value" $ do d3 = date 2020 6 31
let execute handle
d1 = date 2010 2 31 ( Query
d2 = date 2017 2 1 """
d3 = date 2020 6 31
execute handle (Query """
INSERT INTO dates (date) INSERT INTO dates (date)
VALUES ($1), ($2), ($3) 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 * SELECT *
FROM dates FROM dates
ORDER BY date ASC ORDER BY date ASC
""") Row0 """
pgEqual 3 (length dates) )
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3]) Row0
pgEqual 3 (length dates)
test handle "handling Foreign.Object as json and jsonb" $ do liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [ d1, d2, d3 ])
let jsonIn = Object.fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3] test handle "handling Foreign.Object as json and jsonb"
let expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3] $ do
let
execute handle (Query """ 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) INSERT INTO jsons (json, jsonb)
VALUES ($1, $2) VALUES ($1, $2)
""") (Row2 jsonIn jsonIn) """
)
(js ∷ Array (Row2 (Object Int) (Object Int))) <- query handle (Query """SELECT * FROM JSONS""") Row0 (Row2 jsonIn jsonIn)
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js (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 test handle "handling Argonaut.Json as json and jsonb for an object"
let input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ]) $ do
let
execute handle (Query """ input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])
execute handle
( Query
"""
INSERT INTO jsons (json, jsonb) INSERT INTO jsons (json, jsonb)
VALUES ($1, $2) VALUES ($1, $2)
""") (Row2 input input) """
)
(js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0 (Row2 input input)
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js (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 test handle "handling Argonaut.Json as json and jsonb for an array"
let input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])] $ do
let
execute handle (Query """ input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ]) ]
execute handle
( Query
"""
INSERT INTO jsons (json, jsonb) INSERT INTO jsons (json, jsonb)
VALUES ($1, $2) 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 jsd2 = jsdate_ 2017.0 2.0 1.0 12.0 59.0 42.0 999.0
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
test handle "handling jsdate value" $ do jsd3 = jsdate_ 2020.0 6.0 31.0 23.0 3.0 59.0 333.0
let execute handle
jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0 ( Query
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 """
INSERT INTO timestamps (timestamp) INSERT INTO timestamps (timestamp)
VALUES ($1), ($2), ($3) 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 * SELECT *
FROM timestamps FROM timestamps
ORDER BY timestamp ASC 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 validUriToPoolConfigs ::
let doNothing _ = pure unit { uri :: PGConnectionURI
, poolConfig :: Configuration
Test.Unit.test "connection refused" do }
testPool <- liftEffect $ Pool.new (cannotConnectConfig config) validUriToPoolConfigs =
runExceptT (withConnection testPool doNothing) >>= case _ of { uri: "postgres://urllgqrivcyako:c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo"
Left (ConnectionError cause) -> equal cause "ECONNREFUSED" , poolConfig:
_ -> Test.Unit.failure "foo" { database: "e7cecg4nirunpo"
, host: Just "ec2-79-124-25-231.eu-west-1.compute.amazonaws.com"
Test.Unit.test "no such database" do , idleTimeoutMillis: Nothing
testPool <- liftEffect $ Pool.new (noSuchDatabaseConfig config) , max: Nothing
runExceptT (withConnection testPool doNothing) >>= case _ of , password: Just "c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969"
Left (ProgrammingError { code, message }) -> equal code "3D000" , port: Just 5432
_ -> Test.Unit.failure "PostgreSQL error was expected" , user: Just "urllgqrivcyako"
}
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"
}
}
notValidConnUri :: PGConnectionURI notValidConnUri :: PGConnectionURI
notValidConnUri = "postgres://urllgqrivcyakoc52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo" notValidConnUri = "postgres://urllgqrivcyakoc52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo"