server: add tests for transaction commit/rollback

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3418
GitOrigin-RevId: fde6ce718cebabed53c90369215358c248a9658f
This commit is contained in:
Evie Ciobanu 2022-01-21 14:48:01 +02:00 committed by hasura-bot
parent abefdd31d0
commit dc113cc2b8
2 changed files with 233 additions and 96 deletions

View File

@ -125,7 +125,7 @@ singleRowQueryE ef = rawQueryE ef singleRowResult
-- @
--
-- See 'multiRowQueryE' if you need to map the error type as well.
multiRowQuery :: (MonadIO m, FromRow a) => ODBC.Query -> TxT m [a]
multiRowQuery :: forall a m. (MonadIO m, FromRow a) => ODBC.Query -> TxT m [a]
multiRowQuery = multiRowQueryE id
-- | Useful for building query transactions which return multiple rows.

View File

@ -1,109 +1,251 @@
module Database.MSSQL.TransactionSpec (spec) where
import Control.Exception.Base (bracket)
import Data.ByteString
import Data.ByteString (ByteString)
import Database.MSSQL.Pool
import Database.MSSQL.Transaction
import Database.ODBC.SQLServer as ODBC
( ODBCException (DataRetrievalError, UnsuccessfulReturnCode),
Query,
)
import Hasura.Prelude
import Test.Hspec
-- | Describe a TransactionSpec test, see 'runTest' for additional details.
data TestCase a = TestCase
{ -- | Specifies which transactions to run. They will be executed sequentially,
-- and the value of the last query in the last transaction will be compared
-- against 'expectation'.
--
-- Has to be non-empty (but kept as a list for simplicity/convenience).
transactions :: [Transaction],
-- | Expected result of the test. 'Right' represents a successful outcome.
--
-- Left is presented as a function because we want to be able to partially
-- match error (messages).
expectation :: Either (MSSQLTxError -> Expectation) a,
-- | Which kind of parser to use on the last query of the last transaction:
--
-- * 'unitQuery' for queries returning '()'
-- * 'singleRowQuery' for queries returning 'a'
-- * 'multiRowQuery' for queries returning '[a]'
--
-- Use 'TypeApplications' to specify the return type (needed to disambiguate
-- the 'a' type parameter when needed).
runWith :: Query -> TxT IO a,
-- | Description for the test, used in the test output.
description :: String
}
newtype Transaction = Transaction
{ unTransaction :: [Query]
}
spec :: Text -> Spec
spec connString = do
describe "runTx" $ do
it "runs command in a transaction" $ do
result <- runInConn connString selectQuery
result `shouldBe` Right 1
runBasicChecks connString
transactionStateTests connString
it "commits a successful transaction, returning a single field" $ do
_ <- runInConn connString insertIdQuery
result <- runInConn connString selectIdQuery
result `shouldBe` Right 2
runBasicChecks :: Text -> Spec
runBasicChecks connString =
describe "runTx transaction basic checks" $ do
run
TestCase
{ transactions =
[ Transaction
[ "CREATE TABLE SingleCol (ID INT)",
"INSERT INTO SingleCol VALUES (2)",
"SELECT ID FROM SingleCol"
]
],
expectation = Right 2,
runWith = singleRowQuery @Int,
description = "CREATE, INSERT, SELECT single column"
}
it "commits a successful transaction, returning multiple fields" $ do
_ <- runInConn connString insertNameQuery
result <- runInConn connString selectIdNameQuery
result `shouldBe` Right (2, "A")
run
TestCase
{ transactions =
[ Transaction
[ "CREATE TABLE MultiCol (ID INT, NAME VARCHAR(1))",
"INSERT INTO MultiCol VALUES (2, 'A')",
"SELECT ID, NAME FROM MultiCol"
]
],
expectation = Right (2, "A"),
runWith = singleRowQuery @(Int, ByteString),
description = "CREATE, INSERT, SELECT single multiple columns"
}
it "an unsuccesful transaction, expecting Int" $ do
result <- runInConn connString selectIntQueryFail
either
(matchDataRetrievalError "Expected Int, but got: ByteStringValue \"hello\"")
(\r -> expectationFailure $ "expected Left, returned " <> show r)
result
run
TestCase
{ transactions = [Transaction ["SELECT 'hello'"]],
expectation = matchDataRetrievalError "Expected Int, but got: ByteStringValue \"hello\"",
runWith = singleRowQuery @Int,
description = "SELECT the wrong type"
}
it "a successfull query expecting multiple rows" $ do
result <- runInConn connString selectMultipleIdQuery
result `shouldBe` Right [1, 2]
run
TestCase
{ transactions = [Transaction ["select * from (values (1), (2)) as x(a)"]],
expectation = Right [1, 2],
runWith = multiRowQuery @Int,
description = "SELECT multiple rows"
}
it "an unsuccesful transaction; expecting single row" $ do
result <- runInConn connString selectIdQueryFail
either
(matchDataRetrievalError "expecting single row")
(\r -> expectationFailure $ "expected Left, returned " <> show r)
result
run
TestCase
{ transactions = [Transaction ["select * from (values (1), (2)) as x(a)"]],
expectation = matchDataRetrievalError "expecting single row",
runWith = singleRowQuery @Int,
description = "SELECT multiple rows, expect single row"
}
it "displays the SQL Server error on an unsuccessful transaction" $ do
result <- runInConn connString badQuery
either
(matchQueryError (UnsuccessfulReturnCode "odbc_SQLExecDirectW" (-1) invalidSyntaxError))
(\() -> expectationFailure "expected Left, returned ()")
result
run
TestCase
{ transactions =
[ Transaction
[ "CREATE TABLE BadQuery (ID INT, INVALID_SYNTAX)",
"INSERT INTO BadQuery VALUES (3)"
]
],
expectation =
matchQueryError
(UnsuccessfulReturnCode "odbc_SQLExecDirectW" (-1) invalidSyntaxError),
runWith = unitQuery,
description = "Bad syntax error/transaction rollback"
}
where
-- Partially apply connString to runTest for convenience
run :: forall a. Eq a => Show a => TestCase a -> Spec
run = runTest connString
it "rolls back an unsuccessful transaction" $ do
_ <- runInConn connString badQuery
result <- runInConn connString selectIdQuery
either
(\err -> expectationFailure $ "expected Right, returned " <> show err)
(\value -> value `shouldNotBe` 3)
result
-- | Test COMMIT and ROLLBACK for Active and NoActive states.
--
-- The Uncommittable state can be achieved by running the transaction enclosed
-- in a TRY..CATCH block, which is not currently doable with our current API.
-- Consider changing the API to allow such a test if we ever end up having
-- bugs because of it.
transactionStateTests :: Text -> Spec
transactionStateTests connString =
describe "runTx Transaction State -> Action" $ do
run
TestCase
{ transactions = [Transaction ["SELECT 1"]],
expectation = Right 1,
runWith = singleRowQuery @Int,
description = "Active -> COMMIT"
}
it "displays the connection error on an invalid connection string" $ do
invalidPool <- createMinimalPool "some random invalid connection string"
result <- runExceptT $ runTx selectQuery invalidPool
either
(`shouldBe` MSSQLConnError (UnsuccessfulReturnCode "odbc_SQLDriverConnect" (-1) invalidConnStringError))
(\r -> expectationFailure $ "expected Left, returned " ++ show r)
result
run
TestCase
{ transactions =
[ Transaction
[ "CREATE TABLE SingleCol (ID INT)",
"INSERT INTO SingleCol VALUES (2)"
],
Transaction -- Fail
[ "CREATE TABLE BadQuery (ID INT, INVALID_SYNTAX)",
"UPDATE SingleCol SET ID=3"
],
Transaction ["SELECT ID FROM SingleCol"] -- Grab data from setup
],
expectation = Right 2,
runWith = singleRowQuery @Int,
description = "Active -> ROLLBACK"
}
selectQuery :: TxT IO Int
selectQuery = singleRowQuery "SELECT 1"
run
TestCase
{ transactions =
[ Transaction -- Fail
["COMMIT; SELECT 1"]
],
expectation =
Left
(`shouldBe` MSSQLInternal "No active transaction exist; cannot commit"),
runWith = singleRowQuery @Int,
description = "NoActive -> COMMIT"
}
run
TestCase
{ transactions =
[ Transaction
[ "COMMIT;",
"CREATE TABLE BadQuery (ID INT, INVALID_SYNTAX)"
]
],
-- We should get the error rather than the cannot commit error from the
-- NoActive -> Commit test.
expectation =
matchQueryError
(UnsuccessfulReturnCode "odbc_SQLExecDirectW" (-1) invalidSyntaxError),
runWith = unitQuery,
description = "NoActive -> ROLLBACK"
}
where
-- Partially apply connString to runTest for convenience
run :: forall a. Eq a => Show a => TestCase a -> Spec
run = runTest connString
selectIntQueryFail :: TxT IO Int
selectIntQueryFail = singleRowQuery "SELECT 'hello'"
-- | Run a 'TestCase' by executing the queries in order. The last 'ODBC.Query'
-- is the one we check he result against.
--
-- Beacuse we don't know the type of the result, we need it supplied as part
-- of the 'TestCase':
--
-- * 'unitQuery' for queries returning '()'
-- * 'singleRowQuery' for queries returning 'a'
-- * 'multiRowQuery' for queries returning '[a]'
--
-- Note that we need to use TypeApplications on the 'runWith' function for type
-- checking to work, especially if the values are polymorphic
-- (e.g. numbers or strings).
--
-- Please also note that we are discarding 'Left's from "setup" transactions
-- (all but the last transaction). See the 'runSetup' helper below.
runTest :: forall a. Eq a => Show a => Text -> TestCase a -> Spec
runTest connString TestCase {..} =
it description do
case reverse transactions of
[] -> expectationFailure "Empty transaction list: nothing to do."
(mainTransaction : leadingTransactions) -> do
-- Run all transactions before the last (main) transaction.
runSetup (reverse leadingTransactions)
-- Get the result from the last transaction.
result <-
runInConn connString $
runQueries runWith $
unTransaction mainTransaction
case (result, expectation) of
-- Validate the error is the one we were expecting.
(Left err, Left expected) ->
expected err
-- Verify the success result is the expected one.
(Right res, Right expected) ->
res `shouldBe` expected
-- Expected success but got error. Needs special case because the expected
-- Left is a validator (function).
(Left err, Right expected) ->
expectationFailure $
"Expected " <> show expected <> " but got error: " <> show err
-- Expected error but got success. Needs special case because the expected
-- Left is a validator (function).
(Right res, Left _) ->
expectationFailure $
"Expected error but got success: " <> show res
where
runSetup :: [Transaction] -> IO ()
runSetup [] = pure ()
runSetup (t : ts) = do
-- Discards 'Left's.
_ <- runInConn connString (runQueries unitQuery $ unTransaction t)
runSetup ts
selectIdQueryFail :: TxT IO Int
selectIdQueryFail = singleRowQuery "select * from (values (1), (2)) as x(a)"
selectMultipleIdQuery :: TxT IO [Int]
selectMultipleIdQuery = multiRowQuery "select * from (values (1), (2)) as x(a)"
insertIdQuery :: TxT IO ()
insertIdQuery =
unitQuery
"CREATE TABLE SingleCol (ID INT);INSERT INTO SingleCol VALUES (2);"
selectIdQuery :: TxT IO Int
selectIdQuery =
singleRowQuery
"SELECT ID FROM SingleCol;"
insertNameQuery :: TxT IO ()
insertNameQuery =
unitQuery
"CREATE TABLE MultiCol (ID INT, NAME VARCHAR(1));INSERT INTO MultiCol VALUES (2, 'A');"
selectIdNameQuery :: TxT IO (Int, ByteString)
selectIdNameQuery =
singleRowQuery
"SELECT ID, NAME FROM MultiCol;"
badQuery :: TxT IO ()
badQuery =
unitQuery
"CREATE TABLE BadQuery (ID INT, INVALID_SYNTAX);INSERT INTO BadQuery VALUES (3);"
runQueries :: (Query -> TxT IO x) -> [Query] -> TxT IO x
runQueries _ [] = error $ "Expected at least one query per transaction in " <> description
runQueries f [q] = f q
runQueries f (x : xs) = unitQuery x *> runQueries f xs
-- | spec helper functions
runInConn :: Text -> TxT IO a -> IO (Either MSSQLTxError a)
@ -121,9 +263,14 @@ invalidSyntaxError :: String
invalidSyntaxError =
"[Microsoft][ODBC Driver 17 for SQL Server][SQL Server]The definition for column 'INVALID_SYNTAX' must include a data type."
invalidConnStringError :: String
invalidConnStringError =
"[unixODBC][Driver Manager]Data source name not found and no default driver specified[unixODBC][Driver Manager]Data source name not found and no default driver specified"
matchDataRetrievalError :: String -> Either (MSSQLTxError -> Expectation) a
matchDataRetrievalError = matchQueryError . DataRetrievalError
matchQueryError :: ODBCException -> Either (MSSQLTxError -> Expectation) a
matchQueryError expectedErr = Left $ \case
MSSQLQueryError _ err -> err `shouldBe` expectedErr
MSSQLConnError _ -> expectationFailure unexpectedMSSQLConnError
MSSQLInternal _ -> expectationFailure unexpectedMSSQLInternalError
unexpectedMSSQLInternalError :: String
unexpectedMSSQLInternalError =
@ -132,13 +279,3 @@ unexpectedMSSQLInternalError =
unexpectedMSSQLConnError :: String
unexpectedMSSQLConnError =
"Expected MSSQLQueryError, but got: MSSQLConnError"
matchDataRetrievalError :: String -> MSSQLTxError -> Expectation
matchDataRetrievalError errMessage =
matchQueryError (DataRetrievalError errMessage)
matchQueryError :: ODBCException -> MSSQLTxError -> Expectation
matchQueryError expectedErr = \case
MSSQLQueryError _ err -> err `shouldBe` expectedErr
MSSQLConnError _ -> expectationFailure unexpectedMSSQLConnError
MSSQLInternal _ -> expectationFailure unexpectedMSSQLInternalError