generated from tpl/purs
Merge branch 'master' into master
This commit is contained in:
paluh
GitHub
commit
89e3282ba6
@ -8,69 +8,85 @@ exports.ffiNewPool = function(config) {
|
||||
};
|
||||
};
|
||||
|
||||
exports.ffiConnect = function (pool) {
|
||||
return function (onError, onSuccess) {
|
||||
var p = pool.connect(
|
||||
).then(function(client) {
|
||||
onSuccess({
|
||||
exports.ffiConnect = function (config) {
|
||||
return function (pool) {
|
||||
return function (onError, onSuccess) {
|
||||
var p = pool.connect().then(function(client) {
|
||||
onSuccess(config.right({
|
||||
connection: client,
|
||||
done: function() {
|
||||
return client.release();
|
||||
}
|
||||
});
|
||||
}));
|
||||
}).catch(function(err) {
|
||||
onError(err);
|
||||
var pgError = config.nullableLeft(err)
|
||||
if (pgError) {
|
||||
onSuccess(pgError)
|
||||
} else {
|
||||
onError(err);
|
||||
}
|
||||
});
|
||||
|
||||
return function (cancelError, cancelerError, cancelerSuccess) {
|
||||
p.cancel();
|
||||
cancelerSuccess();
|
||||
return function (cancelError, cancelerError, cancelerSuccess) {
|
||||
p.cancel();
|
||||
cancelerSuccess();
|
||||
};
|
||||
};
|
||||
};
|
||||
};
|
||||
|
||||
exports.ffiUnsafeQuery = function(client) {
|
||||
return function(sql) {
|
||||
return function(values) {
|
||||
return function(onError, onSuccess) {
|
||||
var q = client.query({
|
||||
exports.ffiUnsafeQuery = function(config) {
|
||||
return function(client) {
|
||||
return function(sql) {
|
||||
return function(values) {
|
||||
return function(onError, onSuccess) {
|
||||
var q = client.query({
|
||||
text: sql,
|
||||
values: values,
|
||||
rowMode: 'array',
|
||||
}).then(function(result) {
|
||||
onSuccess(result.rows);
|
||||
onSuccess(config.right(result))
|
||||
}).catch(function(err) {
|
||||
onError(err);
|
||||
var pgError = config.nullableLeft(err);
|
||||
if (pgError) {
|
||||
onSuccess(pgError)
|
||||
} else {
|
||||
onError(err);
|
||||
}
|
||||
});
|
||||
|
||||
return function (cancelError, cancelerError, cancelerSuccess) {
|
||||
q.cancel();
|
||||
cancelerSuccess();
|
||||
return function (cancelError, cancelerError, cancelerSuccess) {
|
||||
q.cancel();
|
||||
cancelerSuccess();
|
||||
};
|
||||
};
|
||||
};
|
||||
};
|
||||
};
|
||||
};
|
||||
|
||||
exports.ffiUnsafeCommand = function(client) {
|
||||
return function(sql) {
|
||||
return function(values) {
|
||||
return function(onError, onSuccess) {
|
||||
var q = client.query({
|
||||
text: sql,
|
||||
values: values,
|
||||
rowMode: 'array',
|
||||
}).catch(function(err) {
|
||||
onError(err);
|
||||
}).then(function(result) {
|
||||
onSuccess(result.rowCount);
|
||||
});
|
||||
exports.ffiSQLState = function (error) {
|
||||
return error.code || null;
|
||||
}
|
||||
|
||||
return function (cancelError, cancelerError, cancelerSuccess) {
|
||||
q.cancel();
|
||||
cancelerSuccess();
|
||||
};
|
||||
};
|
||||
};
|
||||
exports.ffiErrorDetail = function (error) {
|
||||
return {
|
||||
severity: error.severity || '',
|
||||
code: error.code || '',
|
||||
message: error.message || '',
|
||||
detail: error.detail || '',
|
||||
hint: error.hint || '',
|
||||
position: error.position || '',
|
||||
internalPosition: error.internalPosition || '',
|
||||
internalQuery: error.internalQuery || '',
|
||||
where_: error.where || '',
|
||||
schema: error.schema || '',
|
||||
table: error.table || '',
|
||||
column: error.column || '',
|
||||
dataType: error.dataType || '',
|
||||
constraint: error.constraint || '',
|
||||
file: error.file || '',
|
||||
line: error.line || '',
|
||||
routine: error.routine || ''
|
||||
};
|
||||
};
|
||||
}
|
||||
|
||||
@ -1,6 +1,9 @@
|
||||
module Database.PostgreSQL
|
||||
( module Row
|
||||
, module Value
|
||||
, PG
|
||||
, PGError(..)
|
||||
, PGErrorDetail
|
||||
, Database
|
||||
, PoolConfiguration
|
||||
, Pool
|
||||
@ -14,17 +17,23 @@ module Database.PostgreSQL
|
||||
, execute
|
||||
, query
|
||||
, scalar
|
||||
, unsafeQuery
|
||||
, onIntegrityError
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Error.Class (catchError, throwError)
|
||||
import Control.Monad.Error.Class (catchError, throwError, try)
|
||||
import Control.Monad.Except.Trans (ExceptT, except, runExceptT)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Data.Array (head)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Maybe (Maybe(..))
|
||||
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, toNullable)
|
||||
import Data.Nullable (Nullable, toMaybe, toNullable)
|
||||
import Data.String (Pattern(..))
|
||||
import Data.String as String
|
||||
import Data.Traversable (traverse)
|
||||
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)
|
||||
@ -34,11 +43,20 @@ import Effect (Effect)
|
||||
import Effect.Aff (Aff, bracket)
|
||||
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Exception (error)
|
||||
import Effect.Exception (Error)
|
||||
import Foreign (Foreign)
|
||||
|
||||
type Database = String
|
||||
|
||||
-- | PostgreSQL computations run in the `PG` monad. It's just `Aff` stacked with
|
||||
-- | `ExceptT` to provide error handling.
|
||||
-- |
|
||||
-- | Errors originating from database queries or connection to the database are
|
||||
-- | modeled with the `PGError` type. Use `runExceptT` from
|
||||
-- | `Control.Monad.Except.Trans` to turn a `PG a` action into `Aff (Either
|
||||
-- | PGError a)`.
|
||||
type PG a = ExceptT PGError Aff a
|
||||
|
||||
-- | PostgreSQL connection pool configuration.
|
||||
type PoolConfiguration =
|
||||
{ database :: Database
|
||||
@ -75,17 +93,17 @@ derive instance newtypeQuery :: Newtype (Query i o) _
|
||||
-- | Create a new connection pool.
|
||||
newPool :: PoolConfiguration -> Aff Pool
|
||||
newPool cfg =
|
||||
liftEffect <<< ffiNewPool $ cfg'
|
||||
where
|
||||
cfg' =
|
||||
{ user: toNullable cfg.user
|
||||
, password: toNullable cfg.password
|
||||
, host: toNullable cfg.host
|
||||
, port: toNullable cfg.port
|
||||
, database: cfg.database
|
||||
, max: toNullable cfg.max
|
||||
, idleTimeoutMillis: toNullable cfg.idleTimeoutMillis
|
||||
}
|
||||
liftEffect <<< ffiNewPool $ cfg'
|
||||
where
|
||||
cfg' =
|
||||
{ user: toNullable cfg.user
|
||||
, password: toNullable cfg.password
|
||||
, host: toNullable cfg.host
|
||||
, port: toNullable cfg.port
|
||||
, database: cfg.database
|
||||
, max: toNullable cfg.max
|
||||
, idleTimeoutMillis: toNullable cfg.idleTimeoutMillis
|
||||
}
|
||||
|
||||
-- | Configuration which we actually pass to FFI.
|
||||
type PoolConfiguration' =
|
||||
@ -107,43 +125,66 @@ foreign import ffiNewPool
|
||||
withConnection
|
||||
:: ∀ a
|
||||
. Pool
|
||||
-> (Connection -> Aff a)
|
||||
-> Aff a
|
||||
-> (Connection -> PG a)
|
||||
-> PG a
|
||||
withConnection p k =
|
||||
bracket
|
||||
(connect p)
|
||||
(liftEffect <<< _.done)
|
||||
(k <<< _.connection)
|
||||
except <=< lift $ bracket (connect p) cleanup run
|
||||
where
|
||||
cleanup (Left _) = pure unit
|
||||
cleanup (Right { done }) = liftEffect done
|
||||
|
||||
run (Left err) = pure $ Left err
|
||||
run (Right { connection }) = runExceptT $ k connection
|
||||
|
||||
connect
|
||||
:: Pool
|
||||
-> Aff
|
||||
{ connection :: Connection
|
||||
, done :: Effect Unit
|
||||
}
|
||||
connect = fromEffectFnAff <<< ffiConnect
|
||||
-> Aff (Either PGError ConnectResult)
|
||||
connect =
|
||||
fromEffectFnAff
|
||||
<<< ffiConnect
|
||||
{ nullableLeft: toNullable <<< map Left <<< convertError
|
||||
, right: Right
|
||||
}
|
||||
|
||||
type ConnectResult =
|
||||
{ connection :: Connection
|
||||
, done :: Effect Unit
|
||||
}
|
||||
|
||||
foreign import ffiConnect
|
||||
:: Pool
|
||||
-> EffectFnAff
|
||||
{ connection :: Connection
|
||||
, done :: Effect Unit
|
||||
}
|
||||
:: ∀ 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, and rolled back when the action throws. If you want to
|
||||
-- | 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
|
||||
:: ∀ a
|
||||
. Connection
|
||||
-> Aff a
|
||||
-> Aff a
|
||||
-> PG a
|
||||
-> PG a
|
||||
withTransaction conn action =
|
||||
execute conn (Query "BEGIN TRANSACTION") Row0
|
||||
*> catchError (Right <$> action) (pure <<< Left) >>= case _ of
|
||||
Right a -> execute conn (Query "COMMIT TRANSACTION") Row0 $> a
|
||||
Left e -> execute conn (Query "ROLLBACK TRANSACTION") Row0 *> throwError e
|
||||
begin *> lift (try $ runExceptT action) >>= case _ of
|
||||
Left jsErr -> do
|
||||
rollback
|
||||
lift $ throwError jsErr
|
||||
Right (Left pgErr) -> do
|
||||
rollback
|
||||
throwError pgErr
|
||||
Right (Right value) -> do
|
||||
commit
|
||||
pure value
|
||||
|
||||
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
|
||||
@ -152,7 +193,7 @@ execute
|
||||
=> Connection
|
||||
-> Query i o
|
||||
-> i
|
||||
-> Aff Unit
|
||||
-> PG Unit
|
||||
execute conn (Query sql) values =
|
||||
void $ unsafeQuery conn sql (toSQLRow values)
|
||||
|
||||
@ -164,12 +205,12 @@ query
|
||||
=> Connection
|
||||
-> Query i o
|
||||
-> i
|
||||
-> Aff (Array o)
|
||||
query conn (Query sql) values =
|
||||
unsafeQuery conn sql (toSQLRow values)
|
||||
-> PG (Array o)
|
||||
query conn (Query sql) values = do
|
||||
_.rows <$> unsafeQuery conn sql (toSQLRow values)
|
||||
>>= traverse (fromSQLRow >>> case _ of
|
||||
Right row -> pure row
|
||||
Left msg -> throwError (error msg))
|
||||
Left msg -> throwError $ ConversionError msg)
|
||||
|
||||
-- | Execute a PostgreSQL query and return the first field of the first row in
|
||||
-- | the result.
|
||||
@ -180,46 +221,130 @@ scalar
|
||||
=> Connection
|
||||
-> Query i (Row1 o)
|
||||
-> i
|
||||
-> Aff (Maybe o)
|
||||
-> PG (Maybe o)
|
||||
scalar conn sql values =
|
||||
query conn sql values
|
||||
<#> map (case _ of Row1 a -> a) <<< head
|
||||
|
||||
unsafeQuery
|
||||
:: Connection
|
||||
-> String
|
||||
-> Array Foreign
|
||||
-> Aff (Array (Array Foreign))
|
||||
unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery c s
|
||||
|
||||
foreign import ffiUnsafeQuery
|
||||
:: Connection
|
||||
-> String
|
||||
-> Array Foreign
|
||||
-> EffectFnAff (Array (Array Foreign))
|
||||
|
||||
-- | 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.
|
||||
-- | for example with `DELETE` or `UPDATE` queries.
|
||||
command
|
||||
:: ∀ i
|
||||
. ToSQLRow i
|
||||
=> Connection
|
||||
-> Query i Int
|
||||
-> i
|
||||
-> Aff Int
|
||||
-> PG Int
|
||||
command conn (Query sql) values =
|
||||
unsafeCommand conn sql (toSQLRow values)
|
||||
_.rowCount <$> unsafeQuery conn sql (toSQLRow values)
|
||||
|
||||
unsafeCommand
|
||||
type QueryResult =
|
||||
{ rows :: Array (Array Foreign)
|
||||
, rowCount :: Int
|
||||
}
|
||||
|
||||
unsafeQuery
|
||||
:: Connection
|
||||
-> String
|
||||
-> Array Foreign
|
||||
-> Aff Int
|
||||
unsafeCommand c s = fromEffectFnAff <<< ffiUnsafeCommand c s
|
||||
-> PG QueryResult
|
||||
unsafeQuery c s =
|
||||
except <=< lift <<< fromEffectFnAff <<< ffiUnsafeQuery p c s
|
||||
where
|
||||
p =
|
||||
{ nullableLeft: toNullable <<< map Left <<< convertError
|
||||
, right: Right
|
||||
}
|
||||
|
||||
foreign import ffiUnsafeCommand
|
||||
:: Connection
|
||||
foreign import ffiUnsafeQuery
|
||||
:: { nullableLeft :: Error -> Nullable (Either PGError QueryResult)
|
||||
, right :: QueryResult -> Either PGError QueryResult
|
||||
}
|
||||
-> Connection
|
||||
-> String
|
||||
-> Array Foreign
|
||||
-> EffectFnAff Int
|
||||
-> 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
|
||||
|
||||
134
test/Main.purs
134
test/Main.purs
@ -4,13 +4,14 @@ module Test.Main
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Error.Class (catchError, throwError, try)
|
||||
import Control.Monad.Free (Free)
|
||||
import Control.Monad.Error.Class (throwError, try)
|
||||
import Control.Monad.Except.Trans (runExceptT)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Data.Array (zip)
|
||||
import Data.Date (Date, canonicalDate)
|
||||
import Data.DateTime.Instant (Instant, unInstant)
|
||||
import Data.Decimal as D
|
||||
import Data.Either (isLeft)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Enum (toEnum)
|
||||
import Data.Foldable (all, length)
|
||||
import Data.JSDate (JSDate, jsdate, toInstant)
|
||||
@ -19,38 +20,54 @@ import Data.Maybe (Maybe(..), fromJust)
|
||||
import Data.Newtype (unwrap)
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Data.Tuple.Nested ((/\))
|
||||
import Database.PostgreSQL (Connection, PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, newPool, query, scalar, withConnection, withTransaction)
|
||||
import Database.PostgreSQL (Connection, PG, PGError(..), PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, newPool, onIntegrityError, query, scalar, withConnection, withTransaction)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, error, launchAff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Exception (message)
|
||||
import Foreign.Object (Object, fromFoldable)
|
||||
import Math ((%))
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
import Test.Assert (assert)
|
||||
-- import Test.Example (run) as Example
|
||||
import Test.Unit (TestF, suite)
|
||||
import Test.Example (run) as Example
|
||||
import Test.Unit (TestSuite, suite)
|
||||
import Test.Unit as Test.Unit
|
||||
import Test.Unit.Assert (equal)
|
||||
import Test.Unit.Main (runTest)
|
||||
|
||||
pgEqual :: forall a. Eq a => Show a => a -> a -> PG Unit
|
||||
pgEqual a b = lift $ equal a b
|
||||
|
||||
withRollback
|
||||
∷ ∀ a
|
||||
. Connection
|
||||
→ Aff a
|
||||
→ Aff Unit
|
||||
withRollback conn action = do
|
||||
execute conn (Query "BEGIN TRANSACTION") Row0
|
||||
catchError (action >>= const rollback) (\e -> rollback >>= const (throwError e))
|
||||
where
|
||||
rollback = execute conn (Query "ROLLBACK") Row0
|
||||
∷ Connection
|
||||
→ PG Unit
|
||||
→ PG Unit
|
||||
withRollback conn action =
|
||||
begin *> action *> rollback
|
||||
where
|
||||
begin = execute conn (Query "BEGIN TRANSACTION") Row0
|
||||
rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0
|
||||
|
||||
test
|
||||
∷ ∀ a
|
||||
. Connection
|
||||
∷ Connection
|
||||
→ String
|
||||
→ Aff a
|
||||
→ Free TestF Unit
|
||||
test conn t a = Test.Unit.test t (withRollback conn a)
|
||||
→ PG Unit
|
||||
→ TestSuite
|
||||
test conn name action =
|
||||
Test.Unit.test name $ checkPGErrors $ withRollback conn action
|
||||
|
||||
transactionTest
|
||||
∷ String
|
||||
→ PG Unit
|
||||
→ TestSuite
|
||||
transactionTest name action =
|
||||
Test.Unit.test name $ checkPGErrors $ action
|
||||
|
||||
checkPGErrors :: PG Unit -> Aff Unit
|
||||
checkPGErrors action = do
|
||||
runExceptT action >>= case _ of
|
||||
Left pgError -> Test.Unit.failure "Unexpected PostgreSQL error occured"
|
||||
Right _ -> pure unit
|
||||
|
||||
now ∷ Effect Instant
|
||||
now = unsafePartial $ (fromJust <<< toInstant) <$> JSDate.now
|
||||
@ -68,9 +85,9 @@ main = do
|
||||
-- Running guide from README
|
||||
-- Example.run
|
||||
|
||||
-- Acctual test suite
|
||||
-- Actual test suite
|
||||
pool <- newPool config
|
||||
withConnection pool \conn -> do
|
||||
checkPGErrors $ withConnection pool \conn -> do
|
||||
execute conn (Query """
|
||||
CREATE TEMPORARY TABLE foods (
|
||||
name text NOT NULL,
|
||||
@ -92,7 +109,7 @@ main = do
|
||||
""") Row0
|
||||
|
||||
liftEffect $ runTest $ do
|
||||
suite "Postgresql client" $ do
|
||||
suite "PostgreSQL client" $ do
|
||||
let
|
||||
testCount n = do
|
||||
count <- scalar conn (Query """
|
||||
@ -101,7 +118,7 @@ main = do
|
||||
""") (Row1 n)
|
||||
liftEffect <<< assert $ count == Just true
|
||||
|
||||
Test.Unit.test "transaction commit" $ do
|
||||
transactionTest "transaction commit" do
|
||||
withTransaction conn do
|
||||
execute conn (Query """
|
||||
INSERT INTO foods (name, delicious, price)
|
||||
@ -113,14 +130,37 @@ main = do
|
||||
DELETE FROM foods
|
||||
""") Row0
|
||||
|
||||
Test.Unit.test "transaction rollback" $ do
|
||||
transactionTest "transaction rollback on PostgreSQL error" $ do
|
||||
_ <- try $ withTransaction conn do
|
||||
execute conn (Query """
|
||||
INSERT INTO foods (name, delicious, price)
|
||||
VALUES ($1, $2, $3)
|
||||
""") (Row3 "pork" true (D.fromString "8.30"))
|
||||
testCount 1
|
||||
throwError $ error "fail"
|
||||
|
||||
-- invalid SQL query --> PGError is thrown
|
||||
execute 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 """
|
||||
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
|
||||
|
||||
test conn "usage of rows represented by nested tuples" $ do
|
||||
@ -210,14 +250,13 @@ main = do
|
||||
""") Row0
|
||||
liftEffect <<< assert $ sauerkrautPrice == [Row1 (D.fromString "3.30")]
|
||||
|
||||
test conn "constraint failure" $ do
|
||||
withTransaction conn $ do
|
||||
result <- try $ execute conn (Query """
|
||||
INSERT INTO foods (name)
|
||||
VALUES ($1)
|
||||
""") (Row1 "pork")
|
||||
liftEffect <<< assert $ isLeft result
|
||||
testCount 0
|
||||
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"
|
||||
|
||||
test conn "handling date value" $ do
|
||||
let
|
||||
@ -235,7 +274,7 @@ main = do
|
||||
FROM dates
|
||||
ORDER BY date ASC
|
||||
""") Row0
|
||||
equal 3 (length dates)
|
||||
pgEqual 3 (length dates)
|
||||
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3])
|
||||
|
||||
test conn "handling json and jsonb value" $ do
|
||||
@ -266,9 +305,24 @@ main = do
|
||||
FROM timestamps
|
||||
ORDER BY timestamp ASC
|
||||
""") Row0
|
||||
equal 3 (length timestamps)
|
||||
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 <- newPool cannotConnectConfig
|
||||
runExceptT (withConnection testPool doNothing) >>= case _ of
|
||||
Left (ConnectionError cause) -> equal cause "ECONNREFUSED"
|
||||
_ -> Test.Unit.failure "foo"
|
||||
|
||||
Test.Unit.test "no such database" do
|
||||
testPool <- newPool noSuchDatabaseConfig
|
||||
runExceptT (withConnection testPool doNothing) >>= case _ of
|
||||
Left (ProgrammingError { code, message }) -> equal code "3D000"
|
||||
_ -> Test.Unit.failure "PostgreSQL error was expected"
|
||||
|
||||
config :: PoolConfiguration
|
||||
config =
|
||||
{ user: Nothing
|
||||
@ -279,3 +333,11 @@ config =
|
||||
, max: Nothing
|
||||
, idleTimeoutMillis: Just 1000
|
||||
}
|
||||
|
||||
noSuchDatabaseConfig :: PoolConfiguration
|
||||
noSuchDatabaseConfig =
|
||||
config { database = "this-database-does-not-exist" }
|
||||
|
||||
cannotConnectConfig :: PoolConfiguration
|
||||
cannotConnectConfig =
|
||||
config { host = Just "127.0.0.1", port = Just 45287 }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user