diff --git a/server/src-lib/Database/MSSQL/Transaction.hs b/server/src-lib/Database/MSSQL/Transaction.hs index 2fe696bec51..7b00facf9e9 100644 --- a/server/src-lib/Database/MSSQL/Transaction.hs +++ b/server/src-lib/Database/MSSQL/Transaction.hs @@ -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. diff --git a/server/src-test/Database/MSSQL/TransactionSpec.hs b/server/src-test/Database/MSSQL/TransactionSpec.hs index e39a9b9eb5e..a58b1a2eae2 100644 --- a/server/src-test/Database/MSSQL/TransactionSpec.hs +++ b/server/src-test/Database/MSSQL/TransactionSpec.hs @@ -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