From 10a868b166b846a939f5e8794871c4c08eacdf7b Mon Sep 17 00:00:00 2001 From: Petri Lehtinen Date: Fri, 16 Nov 2018 13:40:30 +0200 Subject: [PATCH 1/4] Implement monadic error handling, get rid of JavaScript exceptions - Add `PGError` type to model different errors that can happen when querying PostgreSQL. The mapping from SQLSTATE to error was inspired by `psycopg2`. - Run all actions in a new `PG` monad, which is just `Aff` stacked with `ExceptT PGError` to provide monadic error handling. Any errors caused by database access are not thrown as JavaScript exceptions anymore. - While at it, remove some duplication between `query` and `command` by reusing `ffiUnsafeQuery` in both cases. --- src/Database/PostgreSQL.js | 100 ++++++++------ src/Database/PostgreSQL.purs | 252 +++++++++++++++++++++++++++-------- test/Main.purs | 139 ++++++++++++++----- 3 files changed, 358 insertions(+), 133 deletions(-) diff --git a/src/Database/PostgreSQL.js b/src/Database/PostgreSQL.js index b120a39..887c5c4 100644 --- a/src/Database/PostgreSQL.js +++ b/src/Database/PostgreSQL.js @@ -8,69 +8,89 @@ 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); + if (config.queryMode === "rows") { + onSuccess(config.right(result.rows)); + } else if (config.queryMode === "rowCount") { + onSuccess(config.right([[result.rowCount]])); + } }).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 || '' }; -}; +} diff --git a/src/Database/PostgreSQL.purs b/src/Database/PostgreSQL.purs index ba502b8..001117e 100644 --- a/src/Database/PostgreSQL.purs +++ b/src/Database/PostgreSQL.purs @@ -1,6 +1,9 @@ module Database.PostgreSQL ( module Row , module Value +, PG +, PGError(..) +, PGErrorDetail , Database , PoolConfiguration , Pool @@ -14,17 +17,24 @@ 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.Bifunctor (lmap) 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 +44,15 @@ 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. +type PG a = ExceptT PGError Aff a + -- | PostgreSQL connection pool configuration. type PoolConfiguration = { database :: Database @@ -107,28 +121,40 @@ 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 @@ -137,13 +163,25 @@ foreign import ffiConnect 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,9 +190,9 @@ execute => Connection -> Query i o -> i - -> Aff Unit + -> PG Unit execute conn (Query sql) values = - void $ unsafeQuery conn sql (toSQLRow values) + void $ unsafeQuery Rows conn sql (toSQLRow values) -- | Execute a PostgreSQL query and return its results. query @@ -164,12 +202,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 + unsafeQuery Rows 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,24 +218,11 @@ 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. @@ -207,19 +232,132 @@ command => Connection -> Query i Int -> i - -> Aff Int -command conn (Query sql) values = - unsafeCommand conn sql (toSQLRow values) + -> PG Int +command conn (Query sql) values = do + result <- unsafeQuery RowCount conn sql (toSQLRow values) + case result of + [[x]] -> except $ lmap ConversionError (Value.fromSQLValue x) + _ -> throwError (ConversionError "unexpected data") -unsafeCommand - :: Connection +data QueryMode + = Rows + | RowCount + + +type QueryResult + = Array (Array Foreign) + + +unsafeQuery + :: QueryMode + -> Connection -> String -> Array Foreign - -> Aff Int -unsafeCommand c s = fromEffectFnAff <<< ffiUnsafeCommand c s + -> PG QueryResult +unsafeQuery m c s = + except <=< lift <<< fromEffectFnAff <<< ffiUnsafeQuery p c s + where + p = + { queryMode: case m of + Rows -> "rows" + RowCount -> "rowCount" + , nullableLeft: toNullable <<< map Left <<< convertError + , right: Right + } -foreign import ffiUnsafeCommand - :: Connection +foreign import ffiUnsafeQuery + :: { queryMode :: String + , nullableLeft :: Error -> Nullable (Either PGError QueryResult) + , right :: QueryResult -> Either PGError QueryResult + } + -> Connection -> String -> Array Foreign - -> EffectFnAff Int + -> EffectFnAff (Either PGError (Array (Array Foreign))) + + +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 diff --git a/test/Main.purs b/test/Main.purs index 7eae202..db6e75b 100644 --- a/test/Main.purs +++ b/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,52 @@ 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, defaultPoolConfiguration, 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.Unit (TestSuite, suite) import Test.Unit as Test.Unit import Test.Unit.Assert (equal) import Test.Unit.Main (runTest) + 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 -> liftEffect $ assert false + Right _ -> pure unit now ∷ Effect Instant now = unsafePartial $ (fromJust <<< toInstant) <$> JSDate.now @@ -66,11 +81,11 @@ main ∷ Effect Unit main = do void $ launchAff do -- Running guide from README - Example.run + --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 +107,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 +116,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 +128,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 @@ -201,14 +239,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 @@ -226,7 +263,7 @@ main = do FROM dates ORDER BY date ASC """) Row0 - equal 3 (length dates) + lift $ equal 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 @@ -257,9 +294,31 @@ main = do FROM timestamps ORDER BY timestamp ASC """) Row0 - equal 3 (length timestamps) + lift $ equal 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) >>= liftEffect <<< case _ of + Left (ConnectionError cause) -> + assert $ cause == "ECONNREFUSED" + + _ -> + assert false + + Test.Unit.test "no such database" do + testPool <- newPool noSuchDatabaseConfig + runExceptT (withConnection testPool doNothing) >>= liftEffect <<< case _ of + Left (ProgrammingError { code, message }) -> do + assert $ code == "3D000" + assert $ message == "database \"this-database-does-not-exist\" does not exist" + + _ -> + assert false + config :: PoolConfiguration config = { user: Nothing @@ -270,3 +329,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 } From 331b681bbfe7423801e386f6547a78c8d5f01fc0 Mon Sep 17 00:00:00 2001 From: Petri Lehtinen Date: Mon, 19 Nov 2018 08:25:59 +0200 Subject: [PATCH 2/4] Revisit docstrings --- src/Database/PostgreSQL.purs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Database/PostgreSQL.purs b/src/Database/PostgreSQL.purs index 001117e..2532866 100644 --- a/src/Database/PostgreSQL.purs +++ b/src/Database/PostgreSQL.purs @@ -49,8 +49,13 @@ import Foreign (Foreign) type Database = String --- | PostgreSQL computations run in the `PG` monad. It's just `Aff` --- | stacked with ExceptT to provide error handling. +-- | 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. @@ -157,7 +162,8 @@ foreign import ffiConnect -> 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 @@ -225,7 +231,7 @@ scalar conn sql values = -- | 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 From 55d3ddd1bb8424ed04fb4685574693e84ca16af1 Mon Sep 17 00:00:00 2001 From: Petri Lehtinen Date: Fri, 30 Nov 2018 07:43:16 +0200 Subject: [PATCH 3/4] Address test comments --- test/Main.purs | 29 ++++++++++++----------------- 1 file changed, 12 insertions(+), 17 deletions(-) diff --git a/test/Main.purs b/test/Main.purs index db6e75b..9775c3d 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -20,7 +20,7 @@ import Data.Maybe (Maybe(..), fromJust) import Data.Newtype (unwrap) import Data.Tuple (Tuple(..)) import Data.Tuple.Nested ((/\)) -import Database.PostgreSQL (Connection, PG, PGError(..), PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, defaultPoolConfiguration, execute, newPool, onIntegrityError, 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) @@ -35,6 +35,8 @@ 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 ∷ Connection @@ -64,7 +66,7 @@ transactionTest name action = checkPGErrors :: PG Unit -> Aff Unit checkPGErrors action = do runExceptT action >>= case _ of - Left pgError -> liftEffect $ assert false + Left pgError -> Test.Unit.failure "Unexpected PostgreSQL error occured" Right _ -> pure unit now ∷ Effect Instant @@ -263,7 +265,7 @@ main = do FROM dates ORDER BY date ASC """) Row0 - lift $ 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 @@ -294,7 +296,7 @@ main = do FROM timestamps ORDER BY timestamp ASC """) Row0 - lift $ 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 @@ -302,22 +304,15 @@ main = do Test.Unit.test "connection refused" do testPool <- newPool cannotConnectConfig - runExceptT (withConnection testPool doNothing) >>= liftEffect <<< case _ of - Left (ConnectionError cause) -> - assert $ cause == "ECONNREFUSED" - - _ -> - assert false + 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) >>= liftEffect <<< case _ of - Left (ProgrammingError { code, message }) -> do - assert $ code == "3D000" - assert $ message == "database \"this-database-does-not-exist\" does not exist" - - _ -> - assert false + runExceptT (withConnection testPool doNothing) >>= case _ of + Left (ProgrammingError { code, message }) -> equal code "3D000" + _ -> Test.Unit.failure "PostgreSQL error was expected" config :: PoolConfiguration config = From de6404b82f23903ecb97b2bcbff2c36282c23b14 Mon Sep 17 00:00:00 2001 From: Petri Lehtinen Date: Fri, 30 Nov 2018 08:35:29 +0200 Subject: [PATCH 4/4] Make ffiUnsafeQuery better typed, fix indentation --- src/Database/PostgreSQL.js | 6 +- src/Database/PostgreSQL.purs | 157 +++++++++++++++-------------------- 2 files changed, 70 insertions(+), 93 deletions(-) diff --git a/src/Database/PostgreSQL.js b/src/Database/PostgreSQL.js index 887c5c4..0884a3d 100644 --- a/src/Database/PostgreSQL.js +++ b/src/Database/PostgreSQL.js @@ -45,11 +45,7 @@ exports.ffiUnsafeQuery = function(config) { values: values, rowMode: 'array', }).then(function(result) { - if (config.queryMode === "rows") { - onSuccess(config.right(result.rows)); - } else if (config.queryMode === "rowCount") { - onSuccess(config.right([[result.rowCount]])); - } + onSuccess(config.right(result)) }).catch(function(err) { var pgError = config.nullableLeft(err); if (pgError) { diff --git a/src/Database/PostgreSQL.purs b/src/Database/PostgreSQL.purs index 2532866..ac29e6e 100644 --- a/src/Database/PostgreSQL.purs +++ b/src/Database/PostgreSQL.purs @@ -26,7 +26,6 @@ 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.Bifunctor (lmap) import Data.Either (Either(..)) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -94,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' = @@ -131,11 +130,11 @@ withConnection withConnection p k = except <=< lift $ bracket (connect p) cleanup run where - cleanup (Left _) = pure unit - cleanup (Right { done }) = liftEffect done + cleanup (Left _) = pure unit + cleanup (Right { done }) = liftEffect done - run (Left err) = pure $ Left err - run (Right { connection }) = runExceptT $ k connection + run (Left err) = pure $ Left err + run (Right { connection }) = runExceptT $ k connection connect :: Pool @@ -147,7 +146,6 @@ connect = , right: Right } - type ConnectResult = { connection :: Connection , done :: Effect Unit @@ -184,10 +182,9 @@ withTransaction conn action = pure value where - begin = execute conn (Query "BEGIN TRANSACTION") Row0 - commit = execute conn (Query "COMMIT TRANSACTION") Row0 - rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0 - + 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 @@ -198,7 +195,7 @@ execute -> i -> PG Unit execute conn (Query sql) values = - void $ unsafeQuery Rows conn sql (toSQLRow values) + void $ unsafeQuery conn sql (toSQLRow values) -- | Execute a PostgreSQL query and return its results. query @@ -210,7 +207,7 @@ query -> i -> PG (Array o) query conn (Query sql) values = do - unsafeQuery Rows conn sql (toSQLRow values) + _.rows <$> unsafeQuery conn sql (toSQLRow values) >>= traverse (fromSQLRow >>> case _ of Right row -> pure row Left msg -> throwError $ ConversionError msg) @@ -239,92 +236,77 @@ command -> Query i Int -> i -> PG Int -command conn (Query sql) values = do - result <- unsafeQuery RowCount conn sql (toSQLRow values) - case result of - [[x]] -> except $ lmap ConversionError (Value.fromSQLValue x) - _ -> throwError (ConversionError "unexpected data") - -data QueryMode - = Rows - | RowCount - - -type QueryResult - = Array (Array Foreign) +command conn (Query sql) values = + _.rowCount <$> unsafeQuery conn sql (toSQLRow values) +type QueryResult = + { rows :: Array (Array Foreign) + , rowCount :: Int + } unsafeQuery - :: QueryMode - -> Connection + :: Connection -> String -> Array Foreign -> PG QueryResult -unsafeQuery m c s = - except <=< lift <<< fromEffectFnAff <<< ffiUnsafeQuery p c s - where +unsafeQuery c s = + except <=< lift <<< fromEffectFnAff <<< ffiUnsafeQuery p c s + where p = - { queryMode: case m of - Rows -> "rows" - RowCount -> "rowCount" - , nullableLeft: toNullable <<< map Left <<< convertError - , right: Right - } + { nullableLeft: toNullable <<< map Left <<< convertError + , right: Right + } foreign import ffiUnsafeQuery - :: { queryMode :: String - , nullableLeft :: Error -> Nullable (Either PGError QueryResult) + :: { nullableLeft :: Error -> Nullable (Either PGError QueryResult) , right :: QueryResult -> Either PGError QueryResult } -> Connection -> String -> Array Foreign - -> EffectFnAff (Either PGError (Array (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 - + = 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 + 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 - } + { 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 @@ -358,12 +340,11 @@ convertError err = 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 + catchError db handleError + where handleError e = - case e of - IntegrityError _ -> errorResult - _ -> throwError e + case e of + IntegrityError _ -> errorResult + _ -> throwError e