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

Introduce pool based queries. Move Aff API to separate submodule.

Browse Source
This commit is contained in:
Tomasz Rybarczyk 2020-11-10 14:39:30 +01:00
parent 4a63d6d7c2
commit 76a5b41f3e
8 changed files with 624 additions and 527 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CHANGELOG.md
View File

@ -1,5 +1,13 @@
# Changelog
## v3.1.0
* Move `Pool` related stuff into dedicated submodule. Rename `newPool` to `Pool.new`. (@paluh)
## v3.0.0
* Encode PG error and expose them as a result value. (@akheron)
## Expose connection pieces (29/02/2020)
* Expose `connect` and `ConnectResult` (@srghma)

43
README.md
View File

@ -19,8 +19,9 @@ module Test.README where
import Prelude
import Control.Monad.Except.Trans (ExceptT, runExceptT)
import Database.PostgreSQL.PG (defaultConfiguration, PGError, command, execute, Pool, Connection, query, Query(Query))
import Database.PostgreSQL.PG as PG
import Data.Either (Either(..))
import Database.PostgreSQL (Connection, DBHandle, 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))
import Data.Decimal as Decimal
@ -34,20 +35,18 @@ import Test.Assert (assert)
The whole API for interaction with PostgreSQL is performed asynchronously in `Aff`
(the only function which runs in plain `Effect` is `Pool.new`). Core library
functions usually results in somthing like `Aff (Either PGError a)` which can be easily
wrapped by user into `ExceptT` or any other custom monad stack.
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)`.
We are going to work with `PG` 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.
```purescript
type PG a = ExceptT PGError Aff a
type AppM a = ExceptT PGError Aff a
withConnection :: forall a. Pool -> (Connection -> PG a) -> PG a
withConnection = PG.withConnection runExceptT
withTransaction :: forall a. Connection -> PG a -> PG a
withTransaction = PG.withTransaction runExceptT
withTransaction :: forall a. Pool -> (DBHandle -> AppM a) -> AppM a
withTransaction p = PG.withTransaction runExceptT p
```
We assume here that Postgres is running on a standard local port
@ -58,21 +57,23 @@ is run by our test suite and we want to exit after its execution quickly ;-)
```purescript
run ∷ PG Unit
run ∷ AppM Unit
run = do
pool <- liftEffect $ Pool.new
((defaultConfiguration "purspg") { idleTimeoutMillis = Just 1000 })
withConnection pool \conn -> do
```
We can now create our temporary table which we are going to query in this example.
`execute` ignores result value which is what we want in this case.
`PG.execute` ignores result value which is what we want in this case.
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`.
```purescript
execute conn (Query """
PG.execute (Left pool) (Query """
CREATE TEMPORARY TABLE fruits (
name text NOT NULL,
delicious boolean NOT NULL,
@ -83,11 +84,11 @@ The last `Row0` value indicates that this `Query` doesn't take any additional pa
""") Row0
```
There is `withTransaction` helper provided. You can wrap the whole
There is a `withTransaction` helper provided. You can wrap the whole
piece of interaction with database in it. It will rollback if any exception
is thrown during execution of a given `Aff` block. It excecutes `COMMIT`
in the other case.
We start our session with insert of some data. It is done by `execute`
We start our session with insert of some data. It is done by `PG.execute`
function with `INSERT` statement.
Please notice that we are passing a tuple of the arguments to this query
using dedicated constructor. In this case `Row3`. This library provides types
@ -97,8 +98,8 @@ For details please investigate following classes `ToSQLRow`, `ToSQLValue`,
`FromSQLRow` and `FromSQLValue`.
```purescript
withTransaction conn $ do
execute conn (Query """
withTransaction pool \h -> do
PG.execute h (Query """
INSERT INTO fruits (name, delicious, price)
VALUES ($1, $2, $3)
""") (Row3 "coconut" true (Decimal.fromString "8.30"))
@ -109,7 +110,7 @@ verbose but is not restricted to limited and constant number of arguments.
`/\` is just an alias for the `Tuple` constructor from `Data.Tuple.Nested`.
```purescript
execute conn (Query """
PG.execute h (Query """
INSERT INTO fruits (name, delicious, price)
VALUES ($1, $2, $3)
""") ("lemon" /\ false /\ Decimal.fromString "3.30")
@ -120,7 +121,7 @@ data from db.
`query` function processes db response and returns an `Array` of rows.
```purescript
names <- query conn (Query """
names <- PG.query (Left pool) (Query """
SELECT name, delicious
FROM fruits
ORDER BY name ASC
@ -135,7 +136,7 @@ For example we can have: `DELETE rows`, `UPDATE rows`, `INSERT oid rows` etc.
This function should return `rows` value associated with given response.
```purescript
deleted <- command conn (Query """DELETE FROM fruits """) Row0
deleted <- PG.command (Left pool) (Query """DELETE FROM fruits """) Row0
liftEffect <<< assert $ deleted == 2
```

293
src/Database/PostgreSQL.purs
View File

@ -1,298 +1,11 @@
module Database.PostgreSQL
( module Pool
( module Aff
, module Pool
, module Row
, module Value
, PGError(..)
, PGErrorDetail
, Connection
, ConnectResult
, Query(..)
, connect
, withConnection
, withTransaction
, command
, execute
, query
, scalar
) where
import Prelude
import Control.Monad.Error.Class (catchError, throwError)
import Data.Array (head)
import Data.Bifunctor (lmap)
import Data.Either (Either(..), either, hush)
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype)
import Data.Nullable (Nullable, toMaybe, toNullable)
import Data.String (Pattern(..))
import Data.String as String
import Data.Traversable (traverse)
import Database.PostgreSQL.Aff (Connection, ConnectResult, Query(..), PGError(..), PGErrorDetail) as Aff
import Database.PostgreSQL.Pool (Configuration, Database, parseURI, PGConnectionURI, new, Pool, defaultConfiguration) as Pool
import Database.PostgreSQL.Pool (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(..), fromSQLRow, toSQLRow)
import Database.PostgreSQL.Value (class FromSQLValue)
import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, instantFromString, instantToString, null, toSQLValue, unsafeIsBuffer) as Value
import Effect (Effect)
import Effect.Aff (Aff, bracket)
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
import Effect.Class (liftEffect)
import Effect.Exception (Error)
import Foreign (Foreign)
-- | PostgreSQL connection.
foreign import data Connection :: Type
-- | PostgreSQL query with parameter (`$1`, `$2`, …) and return types.
newtype Query i o
= Query String
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 ::
forall a.
Pool ->
(Either PGError Connection -> Aff a) ->
Aff a
withConnection p k = bracket (connect p) cleanup run
where
cleanup (Left _) = pure unit
cleanup (Right { done }) = liftEffect done
run (Left err) = k (Left err)
run (Right { connection }) = k (Right connection)
connect ::
Pool ->
Aff (Either PGError ConnectResult)
connect =
fromEffectFnAff
<<< ffiConnect
{ nullableLeft: toNullable <<< map Left <<< convertError
, right: Right
}
type ConnectResult
= { connection :: Connection
, done :: Effect Unit
}
foreign import ffiConnect ::
forall a.
{ nullableLeft :: Error -> Nullable (Either PGError ConnectResult)
, right :: a -> Either PGError ConnectResult
} ->
Pool ->
EffectFnAff (Either PGError ConnectResult)
-- | Run an action within a transaction. The transaction is committed if the
-- | action returns cleanly, and rolled back if the action throws (either a
-- | `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.
withTransaction ::
forall a.
Connection ->
Aff a ->
Aff (Either PGError a)
withTransaction conn action =
begin
>>= case _ of
Nothing -> do
a <-
action
`catchError`
\jsErr -> do
void $ rollback
throwError jsErr
commit
>>= case _ of
Just pgError -> pure (Left pgError)
Nothing -> pure (Right a)
Just pgError -> pure (Left pgError)
where
begin = execute conn (Query "BEGIN TRANSACTION") Row0
commit = execute conn (Query "COMMIT TRANSACTION") Row0
rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0
-- | Execute a PostgreSQL query and discard its results.
execute ::
forall i o.
(ToSQLRow i) =>
Connection ->
Query i o ->
i ->
Aff (Maybe PGError)
execute conn (Query sql) values = hush <<< either Right Left <$> unsafeQuery conn sql (toSQLRow values)
-- | Execute a PostgreSQL query and return its results.
query ::
forall i o.
ToSQLRow i =>
FromSQLRow o =>
Connection ->
Query i o ->
i ->
Aff (Either PGError (Array o))
query conn (Query sql) values = do
r <- unsafeQuery conn sql (toSQLRow values)
pure $ r >>= _.rows >>> traverse (fromSQLRow >>> lmap ConversionError)
-- | Execute a PostgreSQL query and return the first field of the first row in
-- | the result.
scalar ::
forall i o.
ToSQLRow i =>
FromSQLValue o =>
Connection ->
Query i (Row1 o) ->
i ->
Aff (Either PGError (Maybe o))
scalar conn sql values = query conn sql values <#> map (head >>> map (case _ of Row1 a -> a))
-- | Execute a PostgreSQL query and return its command tag value
-- | (how many rows were affected by the query). This may be useful
-- | for example with `DELETE` or `UPDATE` queries.
command ::
forall i.
ToSQLRow i =>
Connection ->
Query i Int ->
i ->
Aff (Either PGError Int)
command conn (Query sql) values = map _.rowCount <$> unsafeQuery conn sql (toSQLRow values)
type QueryResult
= { rows :: Array (Array Foreign)
, rowCount :: Int
}
unsafeQuery ::
Connection ->
String ->
Array Foreign ->
Aff (Either PGError QueryResult)
unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p c s
where
p =
{ nullableLeft: toNullable <<< map Left <<< convertError
, right: Right
}
foreign import ffiUnsafeQuery ::
{ nullableLeft :: Error -> Nullable (Either PGError QueryResult)
, right :: QueryResult -> Either PGError QueryResult
} ->
Connection ->
String ->
Array Foreign ->
EffectFnAff (Either PGError QueryResult)
data PGError
= ConnectionError String
| ConversionError String
| InternalError PGErrorDetail
| OperationalError PGErrorDetail
| ProgrammingError PGErrorDetail
| IntegrityError PGErrorDetail
| DataError PGErrorDetail
| NotSupportedError PGErrorDetail
| QueryCanceledError PGErrorDetail
| TransactionRollbackError PGErrorDetail
derive instance eqPGError :: Eq PGError
derive instance genericPGError :: Generic PGError _
instance showPGError :: Show PGError where
show = genericShow
type PGErrorDetail
= { severity :: String
, code :: String
, message :: String
, detail :: String
, hint :: String
, position :: String
, internalPosition :: String
, internalQuery :: String
, where_ :: String
, schema :: String
, table :: String
, column :: String
, dataType :: String
, constraint :: String
, file :: String
, line :: String
, routine :: String
}
foreign import ffiSQLState :: Error -> Nullable String
foreign import ffiErrorDetail :: Error -> PGErrorDetail
convertError :: Error -> Maybe PGError
convertError err = case toMaybe $ ffiSQLState err of
Nothing -> Nothing
Just sqlState -> Just $ convert sqlState $ ffiErrorDetail err
where
convert :: String -> PGErrorDetail -> PGError
convert s =
if prefix "0A" s then
NotSupportedError
else if prefix "20" s || prefix "21" s then
ProgrammingError
else if prefix "22" s then
DataError
else if prefix "23" s then
IntegrityError
else if prefix "24" s || prefix "25" s then
InternalError
else if prefix "26" s || prefix "27" s || prefix "28" s then
OperationalError
else if prefix "2B" s || prefix "2D" s || prefix "2F" s then
InternalError
else if prefix "34" s then
OperationalError
else if prefix "38" s || prefix "39" s || prefix "3B" s then
InternalError
else if prefix "3D" s || prefix "3F" s then
ProgrammingError
else if prefix "40" s then
TransactionRollbackError
else if prefix "42" s || prefix "44" s then
ProgrammingError
else if s == "57014" then
QueryCanceledError
else if prefix "5" s then
OperationalError
else if prefix "F" s then
InternalError
else if prefix "H" s then
OperationalError
else if prefix "P" s then
InternalError
else if prefix "X" s then
InternalError
else
const $ ConnectionError s
prefix :: String -> String -> Boolean
prefix p = maybe false (_ == 0) <<< String.indexOf (Pattern p)
-- onIntegrityError :: forall a. PG a -> PG a -> PG a
-- onIntegrityError errorResult db =
-- catchError db handleError
-- where
-- handleError e =
-- case e of
-- IntegrityError _ -> errorResult
-- _ -> throwError e

5
src/Database/PostgreSQL.js → src/Database/PostgreSQL/Aff.js
View File

@ -43,11 +43,12 @@ exports.ffiConnect = function (config) {
};
exports.ffiUnsafeQuery = function(config) {
return function(client) {
// Either `Pool` or `Client` instance
return function(dbHandle) {
return function(sql) {
return function(values) {
return function(onError, onSuccess) {
var q = client.query({
var q = dbHandle.query({
text: sql,
values: values,
rowMode: 'array',

341
src/Database/PostgreSQL/Aff.purs Normal file
View File

@ -0,0 +1,341 @@
module Database.PostgreSQL.Aff
( DBHandle
, PGError(..)
, PGErrorDetail
, Connection
, ConnectResult
, Query(..)
, connect
, withConnection
, withConnectionTransaction
, withDBHandle
, withTransaction
, command
, execute
, query
, scalar
) where
import Prelude
import Control.Monad.Error.Class (catchError, throwError)
import Data.Array (head)
import Data.Bifunctor (lmap)
import Data.Either (Either(..), either, hush)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype)
import Data.Nullable (Nullable, toMaybe, toNullable)
import Data.Profunctor (lcmap)
import Data.String (Pattern(..))
import Data.String as String
import Data.Traversable (traverse)
import Database.PostgreSQL.Pool (Pool)
import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1(..), fromSQLRow, toSQLRow)
import Database.PostgreSQL.Value (class FromSQLValue)
import Effect (Effect)
import Effect.Aff (Aff, bracket)
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
import Effect.Class (liftEffect)
import Effect.Exception (Error)
import Foreign (Foreign)
import Unsafe.Coerce (unsafeCoerce)
-- | PostgreSQL connection.
foreign import data Connection :: Type
-- | PostgreSQL query with parameter (`$1`, `$2`, …) and return types.
newtype Query i o
= Query String
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 ::
forall a.
Pool ->
(Either PGError Connection -> Aff a) ->
Aff a
withConnection p k = bracket (connect p) cleanup run
where
cleanup (Left _) = pure unit
cleanup (Right { done }) = liftEffect done
run (Left err) = k (Left err)
run (Right { connection }) = k (Right connection)
-- | Trivial helper / shortcut which also wraps
-- | the connection to provide `DBHandle`.
withDBHandle ::
forall a.
Pool ->
(Either PGError DBHandle -> Aff a) ->
Aff a
withDBHandle p k = withConnection p (lcmap (map Right) k)
connect ::
Pool ->
Aff (Either PGError ConnectResult)
connect =
fromEffectFnAff
<<< ffiConnect
{ nullableLeft: toNullable <<< map Left <<< convertError
, right: Right
}
type ConnectResult
= { connection :: Connection
, done :: Effect Unit
}
foreign import ffiConnect ::
forall a.
{ nullableLeft :: Error -> Nullable (Either PGError ConnectResult)
, right :: a -> Either PGError ConnectResult
} ->
Pool ->
EffectFnAff (Either PGError ConnectResult)
-- | TODO: Provide docs
withTransaction ::
forall a.
Pool ->
(DBHandle -> Aff a) ->
Aff (Either PGError a)
withTransaction pool action =
withConnection pool case _ of
Right conn -> withConnectionTransaction conn do
(action $ Right conn)
Left err → pure $ Left err
-- | TODO: Outdated docs
-- | Run an action within a transaction. The transaction is committed if the
-- | action returns cleanly, and rolled back if the action throws (either a
-- | `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 ::
forall a.
Connection ->
Aff a ->
Aff (Either PGError a)
withConnectionTransaction conn action =
begin
>>= case _ of
Nothing -> do
a <-
action
`catchError`
\jsErr -> do
void $ rollback
throwError jsErr
commit
>>= case _ of
Just pgError -> pure (Left pgError)
Nothing -> pure (Right a)
Just pgError -> pure (Left pgError)
where
h = Right conn
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
-- | APIs of the `Pool.query` and `Client.query` are the same.
-- | We can dse this polyformphis to simplify ffi.
foreign import data UntaggedDBHandle ∷ Type
-- | Execute a PostgreSQL query and discard its results.
execute ::
forall i o.
(ToSQLRow i) =>
DBHandle ->
Query i o ->
i ->
Aff (Maybe PGError)
execute h (Query sql) values = hush <<< either Right Left <$> unsafeQuery h sql (toSQLRow values)
-- | Execute a PostgreSQL query and return its results.
query ::
forall i o.
ToSQLRow i =>
FromSQLRow o =>
DBHandle ->
Query i o ->
i ->
Aff (Either PGError (Array o))
query h (Query sql) values = do
r <- unsafeQuery h sql (toSQLRow values)
pure $ r >>= _.rows >>> traverse (fromSQLRow >>> lmap ConversionError)
-- | Execute a PostgreSQL query and return the first field of the first row in
-- | the result.
scalar ::
forall i o.
ToSQLRow i =>
FromSQLValue o =>
DBHandle ->
Query i (Row1 o) ->
i ->
Aff (Either PGError (Maybe o))
scalar h sql values = query h sql values <#> map (head >>> map (case _ of Row1 a -> a))
-- | Execute a PostgreSQL query and return its command tag value
-- | (how many rows were affected by the query). This may be useful
-- | for example with `DELETE` or `UPDATE` queries.
command ::
forall i.
ToSQLRow i =>
DBHandle ->
Query i Int ->
i ->
Aff (Either PGError Int)
command h (Query sql) values = map _.rowCount <$> unsafeQuery h sql (toSQLRow values)
type QueryResult
= { rows :: Array (Array Foreign)
, rowCount :: Int
}
unsafeQuery ::
DBHandle ->
String ->
Array Foreign ->
Aff (Either PGError QueryResult)
unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler c) s
where
toUntaggedHandler ∷ DBHandle → UntaggedDBHandle
toUntaggedHandler (Left pool) = unsafeCoerce pool
toUntaggedHandler (Right conn) = unsafeCoerce conn
p =
{ nullableLeft: toNullable <<< map Left <<< convertError
, right: Right
}
foreign import ffiUnsafeQuery ::
{ nullableLeft :: Error -> Nullable (Either PGError QueryResult)
, right :: QueryResult -> Either PGError QueryResult
} ->
UntaggedDBHandle ->
String ->
Array Foreign ->
EffectFnAff (Either PGError QueryResult)
data PGError
= ConnectionError String
| ConversionError String
| InternalError PGErrorDetail
| OperationalError PGErrorDetail
| ProgrammingError PGErrorDetail
| IntegrityError PGErrorDetail
| DataError PGErrorDetail
| NotSupportedError PGErrorDetail
| QueryCanceledError PGErrorDetail
| TransactionRollbackError PGErrorDetail
derive instance eqPGError :: Eq PGError
derive instance genericPGError :: Generic PGError _
instance showPGError :: Show PGError where
show = genericShow
type PGErrorDetail
= { severity :: String
, code :: String
, message :: String
, detail :: String
, hint :: String
, position :: String
, internalPosition :: String
, internalQuery :: String
, where_ :: String
, schema :: String
, table :: String
, column :: String
, dataType :: String
, constraint :: String
, file :: String
, line :: String
, routine :: String
}
foreign import ffiSQLState :: Error -> Nullable String
foreign import ffiErrorDetail :: Error -> PGErrorDetail
convertError :: Error -> Maybe PGError
convertError err = case toMaybe $ ffiSQLState err of
Nothing -> Nothing
Just sqlState -> Just $ convert sqlState $ ffiErrorDetail err
where
convert :: String -> PGErrorDetail -> PGError
convert s =
if prefix "0A" s then
NotSupportedError
else
if prefix "20" s || prefix "21" s then
ProgrammingError
else
if prefix "22" s then
DataError
else
if prefix "23" s then
IntegrityError
else
if prefix "24" s || prefix "25" s then
InternalError
else
if prefix "26" s || prefix "27" s || prefix "28" s then
OperationalError
else
if prefix "2B" s || prefix "2D" s || prefix "2F" s then
InternalError
else
if prefix "34" s then
OperationalError
else
if prefix "38" s || prefix "39" s || prefix "3B" s then
InternalError
else
if prefix "3D" s || prefix "3F" s then
ProgrammingError
else
if prefix "40" s then
TransactionRollbackError
else
if prefix "42" s || prefix "44" s then
ProgrammingError
else
if s == "57014" then
QueryCanceledError
else
if prefix "5" s then
OperationalError
else
if prefix "F" s then
InternalError
else
if prefix "H" s then
OperationalError
else
if prefix "P" s then
InternalError
else
if prefix "X" s then
InternalError
else
const $ ConnectionError s
prefix :: String -> String -> Boolean
prefix p = maybe false (_ == 0) <<< String.indexOf (Pattern p)

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

@ -1,132 +1,158 @@
module Database.PostgreSQL.PG
( module Row
, module Value
, module PostgreSQL
, command
( command
, execute
, query
, onIntegrityError
, query
, scalar
, withConnection
, withConnectionTransaction
, withDBHandle
, withTransaction
) where
import Prelude
import Control.Monad.Error.Class (class MonadError, catchError, throwError)
import Control.Monad.Error.Class (catchError, throwError)
import Control.Monad.Except (class MonadError)
import Data.Either (Either(..), either)
import Data.Maybe (Maybe, maybe)
import Database.PostgreSQL (Connection, PGError(..), Pool, Query)
import Database.PostgreSQL (class FromSQLRow, class FromSQLValue, class ToSQLRow, class ToSQLValue, Connection, Database, PGError(..), PGErrorDetail, Pool, Configuration, Query(..), Row0(..), Row1(..), Row10(..), Row11(..), Row12(..), Row13(..), Row14(..), Row15(..), Row16(..), Row17(..), Row18(..), Row19(..), Row2(..), Row3(..), Row4(..), Row5(..), Row6(..), Row7(..), Row8(..), Row9(..), defaultConfiguration, fromSQLRow, fromSQLValue, instantFromString, instantToString, new, null, toSQLRow, toSQLValue, unsafeIsBuffer) as PostgreSQL
import Database.PostgreSQL (command, execute, query, scalar, withConnection, withTransaction) as P
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 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.Pool (Pool)
import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1)
import Database.PostgreSQL.Value (class FromSQLValue)
import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, instantFromString, instantToString, null, toSQLValue, unsafeIsBuffer) as Value
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff, liftAff)
hoistAffEither :: forall a m. MonadAff m => MonadError PGError m => Aff (Either PGError a) -> m a
hoistAffEither m = liftAff m >>= either throwError pure
type PG a
= Aff (Either PGError a)
hoistPG :: ∀ a m. MonadAff m => MonadError PGError m => PG a -> m a
hoistPG m = liftAff m >>= either throwError pure
-- | Run an action with a connection. The connection is released to the pool
-- | when the action returns.
withConnection
:: forall a m
. MonadError PGError m
=> MonadAff m
=> (m a -> Aff (Either PGError a))
-> Pool
-> (Connection -> m a)
-> m a
withConnection ::
∀ a m.
MonadError PGError m =>
MonadAff m =>
(m a -> Aff (Either PGError a)) ->
Pool ->
(Connection -> m a) ->
m a
withConnection f p k = do
res <- liftAff $ P.withConnection p case _ of
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
-- | Run an action within a transaction. The transaction is committed if the
-- | action returns cleanly, and rolled back if the action throws (either a
-- | `PGError` or a JavaScript exception in PG context). If you want to
-- | change the transaction mode, issue a separate `SET TRANSACTION` statement
-- | within the transaction.
withTransaction
:: forall a m
. MonadAff m
=> MonadError PGError m
=> (m a -> Aff (Either PGError a))
-> Connection
-> m a
-> m a
withTransaction f conn action = do
res <- liftAff $ P.withTransaction conn (f action)
withTransaction ::
∀ a m.
MonadAff m =>
MonadError PGError m =>
(m a -> Aff (Either PGError a)) ->
Pool ->
(DBHandle -> m a) ->
m a
withTransaction f pool action = do
res <- liftAff $ Aff.withTransaction pool \conn -> do
(f (action conn))
either throwError pure $ join res
withConnectionTransaction ::
∀ a m.
MonadAff m =>
MonadError PGError m =>
(m a -> Aff (Either PGError a)) ->
Connection ->
m a ->
m a
withConnectionTransaction f conn action = do
res <- liftAff $ Aff.withConnectionTransaction conn (f action)
either throwError pure $ join res
-- | Execute a PostgreSQL query and discard its results.
execute
:: forall i o m
. ToSQLRow i
=> MonadError PGError m
=> MonadAff m
=> Connection
-> Query i o
-> i
-> m Unit
execute conn sql values = do
err <- liftAff $ P.execute conn sql values
execute ::
∀ i o m.
ToSQLRow i =>
MonadError PGError m =>
MonadAff m =>
DBHandle ->
Query i o ->
i ->
m Unit
execute h sql values = do
err <- liftAff $ Aff.execute h sql values
maybe (pure unit) throwError err
-- | Execute a PostgreSQL query and return its results.
query
:: forall i o m
. ToSQLRow i
=> FromSQLRow o
=> MonadError PGError m
=> MonadAff m
=> Connection
-> Query i o
-> i
-> m (Array o)
query conn sql = hoistAffEither <<< P.query conn sql
query ::
∀ i o m.
ToSQLRow i =>
FromSQLRow o =>
MonadError PGError m =>
MonadAff m =>
DBHandle ->
Query i o ->
i ->
m (Array o)
query h sql = hoistPG <<< Aff.query h sql
-- | Execute a PostgreSQL query and return the first field of the first row in
-- | the result.
scalar
:: forall i o m
. ToSQLRow i
=> FromSQLValue o
=> MonadError PGError m
=> MonadAff m
=> Connection
-> Query i (Row1 o)
-> i
-> m (Maybe o)
scalar conn sql = hoistAffEither <<< P.scalar conn sql
scalar ::
∀ i o m.
ToSQLRow i =>
FromSQLValue o =>
MonadError PGError m =>
MonadAff m =>
DBHandle ->
Query i (Row1 o) ->
i ->
m (Maybe o)
scalar h sql = hoistPG <<< Aff.scalar h sql
-- | Execute a PostgreSQL query and return its command tag value
-- | (how many rows were affected by the query). This may be useful
-- | for example with `DELETE` or `UPDATE` queries.
command
:: forall i m
. ToSQLRow i
=> MonadError PGError m
=> MonadAff m
=> Connection
-> Query i Int
-> i
-> m Int
command conn sql = hoistAffEither <<< P.command conn sql
command ::
∀ i m.
ToSQLRow i =>
MonadError PGError m =>
MonadAff m =>
DBHandle ->
Query i Int ->
i ->
m Int
command h sql = hoistPG <<< Aff.command h sql
onIntegrityError
:: forall a m
. MonadError PGError m
=> m a
-> m a
-> m a
onIntegrityError errorResult db =
catchError db handleError
onIntegrityError ::
∀ a m.
MonadError PGError m =>
m a ->
m a ->
m a
onIntegrityError errorResult db = catchError db handleError
where
handleError e =
case e of
handleError e = case e of
IntegrityError _ -> errorResult
_ -> throwError e

19
test/Config.purs
View File

@ -1,13 +1,12 @@
module Test.Config where
import Prelude
import Control.Monad.Error.Class (throwError)
import Data.Either (Either(..))
import Data.Map (fromFoldable) as Map
import Data.Newtype (un)
import Data.Validation.Semigroup (V(..))
import Database.PostgreSQL.PG (Configuration)
import Database.PostgreSQL (Configuration)
import Dotenv (loadFile) as DotEnv
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
@ -22,11 +21,12 @@ import Polyform.Batteries.Int (validator) as Int
import Polyform.Validator (runValidator)
import Type.Row (type (+))
validator
∷ ∀ err m
. Monad m
⇒ Env.Validator m (IntExpected + MissingValue + err) Env.Env Configuration
validator = { database: _, host: _, idleTimeoutMillis: _, max: _, password: _, port: _, user: _ }
validator ∷
∀ err m.
Monad m ⇒
Env.Validator m (IntExpected + MissingValue + err) Env.Env Configuration
validator =
{ database: _, host: _, idleTimeoutMillis: _, max: _, password: _, port: _, user: _ }
<$> Env.required "PG_DB" identity
<*> Env.optional "PG_HOST" identity
<*> Env.optional "PG_IDLE_TIMEOUT_MILLISECONDS" Int.validator
@ -39,9 +39,8 @@ load ∷ Aff Configuration
load = do
void $ DotEnv.loadFile
env ← liftEffect $ getEnv <#> (Object.toUnfoldable ∷ _ → Array _) >>> Map.fromFoldable
runValidator validator env >>= un V >>> case _ of
runValidator validator env >>= un V
>>> case _ of
Left err → do
throwError $ error "Configuration error. Please verify your environment and .env file."
Right p → pure p

130
test/Main.purs
View File

@ -22,8 +22,9 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Database.PostgreSQL (PGConnectionURI, parseURI)
import Database.PostgreSQL.PG (Configuration, Connection, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, onIntegrityError, query, scalar)
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.PG (command, execute, onIntegrityError, query, scalar)
import Database.PostgreSQL.PG (withConnection, withConnectionTransaction) as PG
import Database.PostgreSQL.Pool (new) as Pool
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff)
@ -35,49 +36,51 @@ import Math ((%))
import Partial.Unsafe (unsafePartial)
import Test.Assert (assert)
import Test.Config (load) as Config
import Test.README (run, PG, withConnection, withTransaction) as README
import Test.README (AppM)
import Test.README (run) as README
import Test.Unit (TestSuite, suite)
import Test.Unit as Test.Unit
import Test.Unit.Assert (equal)
import Test.Unit.Main (runTest)
type PG a = README.PG a
withConnection :: forall a. Pool -> (Connection -> AppM a) -> AppM a
withConnection = PG.withConnection runExceptT
withConnection :: forall a. Pool -> (Connection -> PG a) -> PG a
withConnection = README.withConnection
withConnectionTransaction :: forall a. Connection -> AppM a -> AppM a
withConnectionTransaction = PG.withConnectionTransaction runExceptT
withTransaction :: forall a. Connection -> PG a -> PG a
withTransaction = README.withTransaction
pgEqual :: forall a. Eq a => Show a => a -> a -> PG Unit
pgEqual :: forall a. Eq a => Show a => a -> a -> AppM Unit
pgEqual a b = lift $ equal a b
withRollback
∷ Connection
→ PG Unit
→ PG Unit
→ AppM Unit
→ AppM Unit
withRollback conn action =
begin *> action *> rollback
where
begin = execute conn (Query "BEGIN TRANSACTION") Row0
rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0
begin = execute (Right conn) (Query "BEGIN TRANSACTION") Row0
rollback = execute (Right conn) (Query "ROLLBACK TRANSACTION") Row0
test
∷ Connection
∷ DBHandle
→ String
→ PG Unit
→ AppM Unit
→ TestSuite
test conn name action =
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
∷ String
→ PG Unit
→ AppM Unit
→ TestSuite
transactionTest name action =
Test.Unit.test name $ checkPGErrors $ action
checkPGErrors :: PG Unit -> Aff Unit
checkPGErrors :: AppM Unit -> Aff Unit
checkPGErrors action = do
runExceptT action >>= case _ of
Left pgError -> Test.Unit.failure ("Unexpected PostgreSQL error occured:" <> unsafeStringify pgError)
@ -111,8 +114,8 @@ main = do
config ← Config.load
pool ← liftEffect $ Pool.new config
checkPGErrors $ withConnection pool \conn -> do
execute conn (Query """
checkPGErrors $ execute (Left pool) (Query """
CREATE TEMPORARY TABLE foods (
name text NOT NULL,
delicious boolean NOT NULL,
@ -132,45 +135,47 @@ main = do
);
""") Row0
checkPGErrors $ withConnection pool \conn -> do
liftEffect $ runTest $ do
suite "PostgreSQL client" $ do
let
testCount n = do
count <- scalar conn (Query """
count <- scalar (Left pool) (Query """
SELECT count(*) = $1
FROM foods
""") (Row1 n)
liftEffect <<< assert $ count == Just true
transactionTest "transaction commit" do
withTransaction conn do
execute conn (Query """
withConnectionTransaction conn do
execute (Right conn) (Query """
INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3)
""") (Row3 "pork" true (D.fromString "8.30"))
testCount 1
testCount 1
execute conn (Query """
execute (Right conn) (Query """
DELETE FROM foods
""") Row0
transactionTest "transaction rollback on PostgreSQL error" $ do
_ <- try $ withTransaction conn do
execute conn (Query """
_ <- try $ withConnectionTransaction conn do
execute (Right conn) (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 conn (Query "foo bar") Row0
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 $ withTransaction conn do
execute conn (Query """
result <- lift $ try $ runExceptT $ withConnectionTransaction conn do
execute (Right conn) (Query """
INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3)
""") (Row3 "pork" true (D.fromString "8.30"))
@ -187,15 +192,18 @@ main = do
-- transaction should've been rolled back
testCount 0
test conn "usage of rows represented by nested tuples" $ do
execute conn (Query """
let
handle = Right conn
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 conn (Query """
names <- query handle (Query """
SELECT name, delicious
FROM foods
WHERE delicious
@ -203,18 +211,18 @@ main = do
""") Row0
liftEffect <<< assert $ names == ["pork" /\ true, "rookworst" /\ true]
test conn "nested tuples as rows - just one element" $ do
test handle "nested tuples as rows - just one element" $ do
let row = date 2010 2 31 /\ unit
execute conn (Query """
execute handle (Query """
INSERT INTO dates (date)
VALUES ($1)
""") row
rows <- query conn (Query "SELECT date FROM dates") Row0
rows <- query handle (Query "SELECT date FROM dates") Row0
liftEffect <<< assert $ rows == [row]
let
insertFood =
execute conn (Query """
execute handle (Query """
INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
""") (Row9
@ -222,9 +230,9 @@ main = do
"sauerkraut" false (D.fromString "3.30")
"rookworst" true (D.fromString "5.60"))
test conn "select column subset" $ do
test handle "select column subset" $ do
insertFood
names <- query conn (Query """
names <- query handle (Query """
SELECT name, delicious
FROM foods
WHERE delicious
@ -232,27 +240,27 @@ main = do
""") Row0
liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true]
test conn "delete returning columns subset" $ do
test handle "delete returning columns subset" $ do
insertFood
deleted <- query conn (Query """
deleted <- query handle (Query """
DELETE FROM foods
WHERE delicious
RETURNING name, delicious
""") Row0
liftEffect <<< assert $ deleted == [Row2 "pork" true, Row2 "rookworst" true]
test conn "delete returning command tag value" $ do
test handle "delete returning command tag value" $ do
insertFood
deleted <- command conn (Query """
deleted <- command handle (Query """
DELETE FROM foods
WHERE delicious
""") Row0
liftEffect <<< assert $ deleted == 2
test conn "handling instant value" $ do
test handle "handling instant value" $ do
before <- liftEffect $ (unwrap <<< unInstant) <$> now
insertFood
added <- query conn (Query """
added <- query handle (Query """
SELECT added
FROM foods
""") Row0
@ -265,9 +273,9 @@ main = do
&& after >= (unwrap $ unInstant t))
added
test conn "handling decimal value" $ do
test handle "handling decimal value" $ do
insertFood
sauerkrautPrice <- query conn (Query """
sauerkrautPrice <- query handle (Query """
SELECT price
FROM foods
WHERE NOT delicious
@ -282,18 +290,18 @@ main = do
pure "integrity error was not handled"
liftEffect $ assert $ result == "integrity error was handled"
test conn "handling date value" $ do
test handle "handling date value" $ do
let
d1 = date 2010 2 31
d2 = date 2017 2 1
d3 = date 2020 6 31
execute conn (Query """
execute handle (Query """
INSERT INTO dates (date)
VALUES ($1), ($2), ($3)
""") (Row3 d1 d2 d3)
(dates :: Array (Row1 Date)) <- query conn (Query """
(dates :: Array (Row1 Date)) <- query handle (Query """
SELECT *
FROM dates
ORDER BY date ASC
@ -301,52 +309,52 @@ main = do
pgEqual 3 (length dates)
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3])
test conn "handling Foreign.Object as json and jsonb" $ do
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 conn (Query """
execute handle (Query """
INSERT INTO jsons (json, jsonb)
VALUES ($1, $2)
""") (Row2 jsonIn jsonIn)
(js ∷ Array (Row2 (Object Int) (Object Int))) <- query conn (Query """SELECT * FROM JSONS""") Row0
(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 conn "handling Argonaut.Json as json and jsonb for an object" $ do
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 conn (Query """
execute handle (Query """
INSERT INTO jsons (json, jsonb)
VALUES ($1, $2)
""") (Row2 input input)
(js ∷ Array (Row2 (Json) (Json))) <- query conn (Query """SELECT * FROM JSONS""") Row0
(js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
test conn "handling Argonaut.Json as json and jsonb for an array" $ do
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 conn (Query """
execute handle (Query """
INSERT INTO jsons (json, jsonb)
VALUES ($1, $2)
""") (Row2 input input)
(js ∷ Array (Row2 (Json) (Json))) <- query conn (Query """SELECT * FROM JSONS""") Row0
(js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
test conn "handling jsdate value" $ do
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 conn (Query """
execute handle (Query """
INSERT INTO timestamps (timestamp)
VALUES ($1), ($2), ($3)
""") (Row3 jsd1 jsd2 jsd3)
(timestamps :: Array (Row1 JSDate)) <- query conn (Query """
(timestamps :: Array (Row1 JSDate)) <- query handle (Query """
SELECT *
FROM timestamps
ORDER BY timestamp ASC