generated from tpl/purs
s/Connection/Client/ + s/DBHandle/Connection/
This commit is contained in:
parent
76a5b41f3e
commit
4c738fe72f
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -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
|
||||||
|
465
test/Main.purs
465
test/Main.purs
@ -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 conn) (Query "BEGIN TRANSACTION") Row0
|
begin = execute (Right client) (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
|
||||||
|
{ host = Just "127.0.0.1"
|
||||||
, port = Just 45287
|
, port = Just 45287
|
||||||
}
|
}
|
||||||
|
|
||||||
main ∷ Effect Unit
|
main ∷ Effect Unit
|
||||||
main = do
|
main = do
|
||||||
void $ launchAff do
|
void
|
||||||
|
$ launchAff do
|
||||||
-- Running guide from README
|
-- Running guide from README
|
||||||
void $ runExceptT $ README.run
|
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,258 +131,365 @@ 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
|
||||||
|
$ do
|
||||||
|
suite "PostgreSQL client"
|
||||||
|
$ do
|
||||||
let
|
let
|
||||||
testCount n = do
|
testCount n = do
|
||||||
count <- scalar (Left pool) (Query """
|
count <-
|
||||||
|
scalar (Left pool)
|
||||||
|
( Query
|
||||||
|
"""
|
||||||
SELECT count(*) = $1
|
SELECT count(*) = $1
|
||||||
FROM foods
|
FROM foods
|
||||||
""") (Row1 n)
|
"""
|
||||||
|
)
|
||||||
|
(Row1 n)
|
||||||
liftEffect <<< assert $ count == Just true
|
liftEffect <<< assert $ count == Just true
|
||||||
|
|
||||||
transactionTest "transaction commit" do
|
transactionTest "transaction commit" do
|
||||||
withConnectionTransaction conn do
|
withClientTransaction client do
|
||||||
execute (Right conn) (Query """
|
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"))
|
"""
|
||||||
|
)
|
||||||
|
(Row3 "pork" true (D.fromString "8.30"))
|
||||||
testCount 1
|
testCount 1
|
||||||
testCount 1
|
testCount 1
|
||||||
execute (Right conn) (Query """
|
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"))
|
"""
|
||||||
|
)
|
||||||
|
(Row3 "pork" true (D.fromString "8.30"))
|
||||||
testCount 1
|
testCount 1
|
||||||
|
|
||||||
-- invalid SQL query --> PGError is thrown
|
-- invalid SQL query --> PGError is thrown
|
||||||
execute (Right conn) (Query "foo bar") Row0
|
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"))
|
"""
|
||||||
|
)
|
||||||
|
(Row3 "pork" true (D.fromString "8.30"))
|
||||||
testCount 1
|
testCount 1
|
||||||
|
|
||||||
-- throw a JavaScript error
|
-- throw a JavaScript error
|
||||||
lift $ throwError $ error "fail"
|
lift $ throwError $ error "fail"
|
||||||
|
|
||||||
-- make sure the JavaScript error was thrown
|
-- make sure the JavaScript error was thrown
|
||||||
liftEffect $ case result of
|
liftEffect
|
||||||
|
$ case result of
|
||||||
Left jsErr -> assert (message jsErr == "fail")
|
Left jsErr -> assert (message jsErr == "fail")
|
||||||
Right _ -> assert false
|
Right _ -> assert false
|
||||||
|
|
||||||
-- transaction should've been rolled back
|
-- transaction should've been rolled back
|
||||||
testCount 0
|
testCount 0
|
||||||
|
|
||||||
let
|
let
|
||||||
handle = Right conn
|
handle = Right client
|
||||||
|
test handle "usage of rows represented by nested tuples"
|
||||||
test handle "usage of rows represented by nested tuples" $ do
|
$ do
|
||||||
execute handle (Query """
|
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)
|
||||||
""")
|
"""
|
||||||
|
)
|
||||||
( ("pork" /\ true /\ (D.fromString "8.30"))
|
( ("pork" /\ true /\ (D.fromString "8.30"))
|
||||||
/\ ("sauerkraut" /\ false /\ (D.fromString "3.30"))
|
/\ ("sauerkraut" /\ false /\ (D.fromString "3.30"))
|
||||||
/\ ("rookworst" /\ true /\ (D.fromString "5.60")))
|
/\ ("rookworst" /\ true /\ (D.fromString "5.60"))
|
||||||
names <- query handle (Query """
|
)
|
||||||
|
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
|
"""
|
||||||
|
)
|
||||||
|
row
|
||||||
rows <- query handle (Query "SELECT date FROM dates") Row0
|
rows <- query handle (Query "SELECT date FROM dates") Row0
|
||||||
liftEffect <<< assert $ rows == [row]
|
liftEffect <<< assert $ rows == [ row ]
|
||||||
|
|
||||||
let
|
let
|
||||||
insertFood =
|
insertFood =
|
||||||
execute handle (Query """
|
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")
|
||||||
|
"sauerkraut"
|
||||||
|
false
|
||||||
|
(D.fromString "3.30")
|
||||||
|
"rookworst"
|
||||||
|
true
|
||||||
|
(D.fromString "5.60")
|
||||||
|
)
|
||||||
|
test handle "select column subset"
|
||||||
|
$ do
|
||||||
insertFood
|
insertFood
|
||||||
names <- query handle (Query """
|
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 ]
|
||||||
|
test handle "delete returning columns subset"
|
||||||
|
$ do
|
||||||
insertFood
|
insertFood
|
||||||
deleted <- query handle (Query """
|
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 ]
|
||||||
|
test handle "delete returning command tag value"
|
||||||
|
$ do
|
||||||
insertFood
|
insertFood
|
||||||
deleted <- command handle (Query """
|
deleted <-
|
||||||
|
command handle
|
||||||
|
( Query
|
||||||
|
"""
|
||||||
DELETE FROM foods
|
DELETE FROM foods
|
||||||
WHERE delicious
|
WHERE delicious
|
||||||
""") Row0
|
"""
|
||||||
|
)
|
||||||
|
Row0
|
||||||
liftEffect <<< assert $ deleted == 2
|
liftEffect <<< assert $ deleted == 2
|
||||||
|
test handle "handling instant value"
|
||||||
test handle "handling instant value" $ do
|
$ do
|
||||||
before <- liftEffect $ (unwrap <<< unInstant) <$> now
|
before <- liftEffect $ (unwrap <<< unInstant) <$> now
|
||||||
insertFood
|
insertFood
|
||||||
added <- query handle (Query """
|
added <-
|
||||||
|
query handle
|
||||||
|
( Query
|
||||||
|
"""
|
||||||
SELECT added
|
SELECT added
|
||||||
FROM foods
|
FROM foods
|
||||||
""") Row0
|
"""
|
||||||
|
)
|
||||||
|
Row0
|
||||||
after <- liftEffect $ (unwrap <<< unInstant) <$> now
|
after <- liftEffect $ (unwrap <<< unInstant) <$> now
|
||||||
-- | timestamps are fetched without milliseconds so we have to
|
-- | timestamps are fetched without milliseconds so we have to
|
||||||
-- | round before value down
|
-- | round before value down
|
||||||
liftEffect <<< assert $ all
|
liftEffect <<< assert
|
||||||
(\(Row1 t) ->
|
$ all
|
||||||
( unwrap $ unInstant t) >= (before - before % 1000.0)
|
( \(Row1 t) ->
|
||||||
&& after >= (unwrap $ unInstant t))
|
(unwrap $ unInstant t) >= (before - before % 1000.0)
|
||||||
|
&& after
|
||||||
|
>= (unwrap $ unInstant t)
|
||||||
|
)
|
||||||
added
|
added
|
||||||
|
test handle "handling decimal value"
|
||||||
test handle "handling decimal value" $ do
|
$ do
|
||||||
insertFood
|
insertFood
|
||||||
sauerkrautPrice <- query handle (Query """
|
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
|
||||||
transactionTest "integrity error handling" $ do
|
liftEffect <<< assert $ sauerkrautPrice == [ Row1 (D.fromString "3.30") ]
|
||||||
withRollback conn do
|
transactionTest "integrity error handling"
|
||||||
result <- onIntegrityError (pure "integrity error was handled") do
|
$ do
|
||||||
|
withRollback client do
|
||||||
|
result <-
|
||||||
|
onIntegrityError (pure "integrity error was handled") do
|
||||||
insertFood
|
insertFood
|
||||||
insertFood
|
insertFood
|
||||||
pure "integrity error was not handled"
|
pure "integrity error was not handled"
|
||||||
liftEffect $ assert $ result == "integrity error was handled"
|
liftEffect $ assert $ result == "integrity error was handled"
|
||||||
|
test handle "handling date value"
|
||||||
test handle "handling date value" $ do
|
$ do
|
||||||
let
|
let
|
||||||
d1 = date 2010 2 31
|
d1 = date 2010 2 31
|
||||||
d2 = date 2017 2 1
|
|
||||||
d3 = date 2020 6 31
|
|
||||||
|
|
||||||
execute handle (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
|
"""
|
||||||
|
)
|
||||||
|
Row0
|
||||||
pgEqual 3 (length dates)
|
pgEqual 3 (length dates)
|
||||||
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3])
|
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [ d1, d2, d3 ])
|
||||||
|
test handle "handling Foreign.Object as json and jsonb"
|
||||||
test handle "handling Foreign.Object as json and jsonb" $ do
|
$ do
|
||||||
let jsonIn = Object.fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3]
|
let
|
||||||
let expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3]
|
jsonIn = Object.fromFoldable [ Tuple "a" 1, Tuple "a" 2, Tuple "2" 3 ]
|
||||||
|
let
|
||||||
execute handle (Query """
|
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)
|
"""
|
||||||
|
)
|
||||||
|
(Row2 jsonIn jsonIn)
|
||||||
(js ∷ Array (Row2 (Object Int) (Object Int))) <- query handle (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
|
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js
|
||||||
|
test handle "handling Argonaut.Json as json and jsonb for an object"
|
||||||
test handle "handling Argonaut.Json as json and jsonb for an object" $ do
|
$ do
|
||||||
let input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])
|
let
|
||||||
|
input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])
|
||||||
execute handle (Query """
|
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
|
(js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0
|
||||||
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
|
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
|
||||||
|
test handle "handling Argonaut.Json as json and jsonb for an array"
|
||||||
test handle "handling Argonaut.Json as json and jsonb for an array" $ do
|
$ do
|
||||||
let input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])]
|
let
|
||||||
|
input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ]) ]
|
||||||
execute handle (Query """
|
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
|
(js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0
|
||||||
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
|
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
|
||||||
|
test handle "handling jsdate value"
|
||||||
test handle "handling jsdate value" $ do
|
$ do
|
||||||
let
|
let
|
||||||
jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0
|
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 """
|
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
|
"""
|
||||||
|
)
|
||||||
|
Row0
|
||||||
pgEqual 3 (length timestamps)
|
pgEqual 3 (length timestamps)
|
||||||
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip timestamps [jsd1, jsd2, jsd3])
|
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip timestamps [ jsd1, jsd2, jsd3 ])
|
||||||
|
suite "PostgreSQL connection errors"
|
||||||
suite "PostgreSQL connection errors" $ do
|
$ do
|
||||||
let doNothing _ = pure unit
|
let
|
||||||
|
doNothing _ = pure unit
|
||||||
Test.Unit.test "connection refused" do
|
Test.Unit.test "connection refused" do
|
||||||
testPool <- liftEffect $ Pool.new (cannotConnectConfig config)
|
testPool <- liftEffect $ Pool.new (cannotConnectConfig config)
|
||||||
runExceptT (withConnection testPool doNothing) >>= case _ of
|
runExceptT (withClient testPool doNothing)
|
||||||
Left (ConnectionError cause) -> equal cause "ECONNREFUSED"
|
>>= case _ of
|
||||||
|
Left (ClientError cause) -> equal cause "ECONNREFUSED"
|
||||||
_ -> Test.Unit.failure "foo"
|
_ -> Test.Unit.failure "foo"
|
||||||
|
|
||||||
Test.Unit.test "no such database" do
|
Test.Unit.test "no such database" do
|
||||||
testPool <- liftEffect $ Pool.new (noSuchDatabaseConfig config)
|
testPool <- liftEffect $ Pool.new (noSuchDatabaseConfig config)
|
||||||
runExceptT (withConnection testPool doNothing) >>= case _ of
|
runExceptT (withClient testPool doNothing)
|
||||||
|
>>= case _ of
|
||||||
Left (ProgrammingError { code, message }) -> equal code "3D000"
|
Left (ProgrammingError { code, message }) -> equal code "3D000"
|
||||||
_ -> Test.Unit.failure "PostgreSQL error was expected"
|
_ -> Test.Unit.failure "PostgreSQL error was expected"
|
||||||
|
|
||||||
Test.Unit.test "get pool configuration from postgres uri" do
|
Test.Unit.test "get pool configuration from postgres uri" do
|
||||||
equal (parseURI validUriToPoolConfigs.uri) (Just validUriToPoolConfigs.poolConfig)
|
equal (parseURI validUriToPoolConfigs.uri) (Just validUriToPoolConfigs.poolConfig)
|
||||||
equal (parseURI notValidConnUri) Nothing
|
equal (parseURI notValidConnUri) Nothing
|
||||||
|
|
||||||
validUriToPoolConfigs :: { uri :: PGConnectionURI
|
validUriToPoolConfigs ::
|
||||||
, poolConfig :: Configuration }
|
{ uri :: PGConnectionURI
|
||||||
validUriToPoolConfigs = { uri: "postgres://urllgqrivcyako:c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo"
|
, poolConfig :: Configuration
|
||||||
, poolConfig: { database: "e7cecg4nirunpo"
|
}
|
||||||
|
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"
|
, host: Just "ec2-79-124-25-231.eu-west-1.compute.amazonaws.com"
|
||||||
, idleTimeoutMillis: Nothing
|
, idleTimeoutMillis: Nothing
|
||||||
, max: Nothing
|
, max: Nothing
|
||||||
|
Loading…
Reference in New Issue
Block a user