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 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

2
src/Database/PostgreSQL.purs
View File

@ -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

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

@ -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)

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

@ -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

613
test/Main.purs
View File

@ -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"