server: add tests for transaction commit/rollback

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3418
GitOrigin-RevId: fde6ce718cebabed53c90369215358c248a9658f

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.

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
+  runBasicChecks connString
-    it "runs command in a transaction" $ do
+  transactionStateTests connString
-      result <- runInConn connString selectQuery
-      result `shouldBe` Right 1
 
-    it "commits a successful transaction, returning a single field" $ do
+runBasicChecks :: Text -> Spec
-      _ <- runInConn connString insertIdQuery
+runBasicChecks connString =
-      result <- runInConn connString selectIdQuery
+  describe "runTx transaction basic checks" $ do
-      result `shouldBe` Right 2
+    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
+    run
-      _ <- runInConn connString insertNameQuery
+      TestCase
-      result <- runInConn connString selectIdNameQuery
+        { transactions =
-      result `shouldBe` Right (2, "A")
+            [ 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
+    run
-      result <- runInConn connString selectIntQueryFail
+      TestCase
-      either
+        { transactions = [Transaction ["SELECT 'hello'"]],
-        (matchDataRetrievalError "Expected Int, but got: ByteStringValue \"hello\"")
+          expectation = matchDataRetrievalError "Expected Int, but got: ByteStringValue \"hello\"",
-        (\r -> expectationFailure $ "expected Left, returned " <> show r)
+          runWith = singleRowQuery @Int,
-        result
+          description = "SELECT the wrong type"
+        }
 
-    it "a successfull query expecting multiple rows" $ do
+    run
-      result <- runInConn connString selectMultipleIdQuery
+      TestCase
-      result `shouldBe` Right [1, 2]
+        { 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
+    run
-      result <- runInConn connString selectIdQueryFail
+      TestCase
-      either
+        { transactions = [Transaction ["select * from (values (1), (2)) as x(a)"]],
-        (matchDataRetrievalError "expecting single row")
+          expectation = matchDataRetrievalError "expecting single row",
-        (\r -> expectationFailure $ "expected Left, returned " <> show r)
+          runWith = singleRowQuery @Int,
-        result
+          description = "SELECT multiple rows, expect single row"
+        }
 
-    it "displays the SQL Server error on an unsuccessful transaction" $ do
+    run
-      result <- runInConn connString badQuery
+      TestCase
-      either
+        { transactions =
-        (matchQueryError (UnsuccessfulReturnCode "odbc_SQLExecDirectW" (-1) invalidSyntaxError))
+            [ Transaction
-        (\() -> expectationFailure "expected Left, returned ()")
+                [ "CREATE TABLE BadQuery (ID INT, INVALID_SYNTAX)",
-        result
+                  "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
+-- | Test COMMIT and ROLLBACK for Active and NoActive states.
-      _ <- runInConn connString badQuery
+--
-      result <- runInConn connString selectIdQuery
+-- The Uncommittable state can be achieved by running the transaction enclosed
-      either
+-- in a TRY..CATCH block, which is not currently doable with our current API.
-        (\err -> expectationFailure $ "expected Right, returned " <> show err)
+-- Consider changing the API to allow such a test if we ever end up having
-        (\value -> value `shouldNotBe` 3)
+-- bugs because of it.
-        result
+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
+    run
-      invalidPool <- createMinimalPool "some random invalid connection string"
+      TestCase
-      result <- runExceptT $ runTx selectQuery invalidPool
+        { transactions =
-      either
+            [ Transaction
-        (`shouldBe` MSSQLConnError (UnsuccessfulReturnCode "odbc_SQLDriverConnect" (-1) invalidConnStringError))
+                [ "CREATE TABLE SingleCol (ID INT)",
-        (\r -> expectationFailure $ "expected Left, returned " ++ show r)
+                  "INSERT INTO SingleCol VALUES (2)"
-        result
+                ],
+              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
+    run
-selectQuery = singleRowQuery "SELECT 1"
+      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
+-- | Run a 'TestCase' by executing the queries in order. The last 'ODBC.Query'
-selectIntQueryFail = singleRowQuery "SELECT 'hello'"
+-- 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
+    runQueries :: (Query -> TxT IO x) -> [Query] -> TxT IO x
-selectIdQueryFail = singleRowQuery "select * from (values (1), (2)) as x(a)"
+    runQueries _ [] = error $ "Expected at least one query per transaction in " <> description
-
+    runQueries f [q] = f q
-selectMultipleIdQuery :: TxT IO [Int]
+    runQueries f (x : xs) = unitQuery x *> runQueries f xs
-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);"
 
 -- | 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
+matchDataRetrievalError :: String -> Either (MSSQLTxError -> Expectation) a
-invalidConnStringError =
+matchDataRetrievalError = matchQueryError . DataRetrievalError
-  "[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"
+
+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