From dd594c8f0a5c6a2bf1295543b3da256ca3f0a4d1 Mon Sep 17 00:00:00 2001 From: japleenkaur Date: Tue, 30 Sep 2025 18:15:31 -0400 Subject: [PATCH 1/4] Added backend tests for retrieveProgram --- .../Controllers/ProgramControllerTests.hs | 61 +++++++++++++++++-- backend-test/TestHelpers.hs | 31 ++++++++++ 2 files changed, 87 insertions(+), 5 deletions(-) diff --git a/backend-test/Controllers/ProgramControllerTests.hs b/backend-test/Controllers/ProgramControllerTests.hs index eb940fe15..e28a74cdd 100644 --- a/backend-test/Controllers/ProgramControllerTests.hs +++ b/backend-test/Controllers/ProgramControllerTests.hs @@ -1,20 +1,71 @@ +{-| +Description: Program Controller module tests. + +Module that contains the tests for the functions in the Program Controller module. +-} + module Controllers.ProgramControllerTests ( test_programController ) where import Config (runDb) import Control.Monad.IO.Class (liftIO) -import Controllers.Program (index) +import Controllers.Program (index, retrieveProgram) import qualified Data.ByteString.Lazy.Char8 as BL +import Data.List (isInfixOf) +import Data.Time.Clock (getCurrentTime) import qualified Data.Text as T -import Data.Time (getCurrentTime) import Database.DataType (PostType (..)) import Database.Persist.Sqlite (SqlPersistM, insert_) import Database.Tables (Post (..)) import Happstack.Server (rsBody) import Test.Tasty (TestTree) -import Test.Tasty.HUnit (assertEqual, testCase) -import TestHelpers (clearDatabase, runServerPart, withDatabase) +import Test.Tasty.HUnit (assertEqual, assertBool, testCase) +import TestHelpers (clearDatabase, runServerPart, runServerPartWithProgramQuery, withDatabase) + +-- | List of test cases as (label, programs to insert, query params, expected output) +retrieveprogramTestCases :: [(String, [T.Text], T.Text , String)] +retrieveprogramTestCases = + [ ("Valid program code returns JSON" + , ["ASMAJ1689"] + , T.pack "ASMAJ1689" + , "\"postCode\":\"ASMAJ1689\"" + ) + , ("Invalid program code returns null JSON" + , [] + , T.pack "INVALID123" + , "null" + ) + , ("Empty code parameter returns error" + , [] + , T.pack "" + , "ERROR" + ) + ] + +-- | Run a test case (case, input, expected output) on the retrieveProgram function. +runRetrieveProgramTest :: String -> [T.Text] -> T.Text -> String -> TestTree +runRetrieveProgramTest label posts queryParam expected = + testCase label $ do + runDb $ do + clearDatabase + insertPrograms posts + + response <- runServerPartWithProgramQuery Controllers.Program.retrieveProgram (T.unpack queryParam) + let actual = BL.unpack $ rsBody response + putStrLn $ "\n[DEBUG] Response for '" ++ label ++ "':\n" ++ actual ++ "\n" + case expected of + "null" -> + assertEqual ("Unexpected body for " ++ label) "null" actual + "ERROR" -> + assertBool ("Expected error body for " ++ label) (not (null actual)) + substr -> + assertBool ("Expected substring not found for " ++ label) + (substr `isInfixOf` actual) + +-- | Run all the retrieveProgram test cases +runRetrieveProgramTests :: [TestTree] +runRetrieveProgramTests = map (\(label, programs, params, expected) -> runRetrieveProgramTest label programs params expected) retrieveprogramTestCases -- | List of test cases as (label, input programs, expected output) indexTestCases :: [(String, [T.Text], String)] @@ -51,4 +102,4 @@ runIndexTests = map (\(label, programs, expected) -> runIndexTest label programs -- | Test suite for Program Controller Module test_programController :: TestTree -test_programController = withDatabase "Program Controller tests" runIndexTests +test_programController = withDatabase "Program Controller tests" (runIndexTests ++ runRetrieveProgramTests) diff --git a/backend-test/TestHelpers.hs b/backend-test/TestHelpers.hs index 20272f84b..74c3d425a 100644 --- a/backend-test/TestHelpers.hs +++ b/backend-test/TestHelpers.hs @@ -13,6 +13,7 @@ module TestHelpers releaseDatabase, runServerPartWithQuery, runServerPartWithCourseInfoQuery, + runServerPartWithProgramQuery, runServerPartWithGraphGenerate, withDatabase) where @@ -107,6 +108,30 @@ mockRequestWithCourseInfoQuery dept = do , rqPeer = ("127.0.0.1", 0) } +-- | A mock request for running ServerPartWithProgramQuery, specifically for retrieveProgram +mockRequestWithProgramQuery :: String -> IO Request +mockRequestWithProgramQuery programCode = do + inputsBody <- newMVar [] + requestBody <- newEmptyMVar + return Request + { rqSecure = False + , rqMethod = GET + , rqPaths = ["program"] + , rqUri = "/program" + , rqQuery = "" + , rqInputsQuery = [("code", Input { + inputValue = Right (BSL8.pack programCode), + inputFilename = Nothing, + inputContentType = defaultContentType + })] + , rqInputsBody = inputsBody + , rqCookies = [] + , rqVersion = HttpVersion 1 1 + , rqHeaders = Map.empty + , rqBody = requestBody + , rqPeer = ("127.0.0.1", 0) + } + -- | A mock request for the graph generate route, specifically for findAndSavePrereqsResponse mockRequestWithGraphGenerate :: BSL.ByteString -> IO Request mockRequestWithGraphGenerate payload = do @@ -149,6 +174,12 @@ runServerPartWithCourseInfoQuery sp dept = do request <- mockRequestWithCourseInfoQuery dept simpleHTTP'' sp request +-- | Helper function to run ServerPartWithQuery Response for retrieveProgram +runServerPartWithProgramQuery :: ServerPart Response -> String -> IO Response +runServerPartWithProgramQuery sp programCode = do + request <- mockRequestWithProgramQuery programCode + simpleHTTP'' sp request + -- | Helper function to run ServerPartWithGraphGenerate for findAndSavePrereqsResponse runServerPartWithGraphGenerate :: ServerPart Response -> BSL.ByteString -> IO Response runServerPartWithGraphGenerate sp payload = do From e6c73136c93dc09d7285ba7e866f10008187c927 Mon Sep 17 00:00:00 2001 From: japleenkaur Date: Tue, 30 Sep 2025 19:22:01 -0400 Subject: [PATCH 2/4] Added CHANGELOG.md and removed test checker. --- CHANGELOG.md | 1 + backend-test/Controllers/ProgramControllerTests.hs | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b5a7dcf3a..5cada3765 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -35,6 +35,7 @@ - Updated backend tests to use `tasty-discover` - Added documentation for running a subset of the backend tests - Deleted `app/Response/Image` file and refactored `app/Util/Helpers` to include `returnImageData` +- Added test cases for the retrieveProgram function in `Controllers/Program` ## [0.7.1] - 2025-06-16 diff --git a/backend-test/Controllers/ProgramControllerTests.hs b/backend-test/Controllers/ProgramControllerTests.hs index e28a74cdd..7cc05def2 100644 --- a/backend-test/Controllers/ProgramControllerTests.hs +++ b/backend-test/Controllers/ProgramControllerTests.hs @@ -53,7 +53,6 @@ runRetrieveProgramTest label posts queryParam expected = response <- runServerPartWithProgramQuery Controllers.Program.retrieveProgram (T.unpack queryParam) let actual = BL.unpack $ rsBody response - putStrLn $ "\n[DEBUG] Response for '" ++ label ++ "':\n" ++ actual ++ "\n" case expected of "null" -> assertEqual ("Unexpected body for " ++ label) "null" actual From e953bd87f5d6902309892638f52d1eae124c5188 Mon Sep 17 00:00:00 2001 From: japleenkaur Date: Fri, 3 Oct 2025 14:41:31 -0400 Subject: [PATCH 3/4] updated retrieveprogramTestCases to include the full JSON response. --- .../Controllers/ProgramControllerTests.hs | 38 ++++++++----------- 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/backend-test/Controllers/ProgramControllerTests.hs b/backend-test/Controllers/ProgramControllerTests.hs index 7cc05def2..3eb888a0c 100644 --- a/backend-test/Controllers/ProgramControllerTests.hs +++ b/backend-test/Controllers/ProgramControllerTests.hs @@ -9,37 +9,39 @@ module Controllers.ProgramControllerTests ( ) where import Config (runDb) -import Control.Monad.IO.Class (liftIO) import Controllers.Program (index, retrieveProgram) import qualified Data.ByteString.Lazy.Char8 as BL -import Data.List (isInfixOf) -import Data.Time.Clock (getCurrentTime) import qualified Data.Text as T +import Data.Time (UTCTime) import Database.DataType (PostType (..)) import Database.Persist.Sqlite (SqlPersistM, insert_) import Database.Tables (Post (..)) import Happstack.Server (rsBody) import Test.Tasty (TestTree) -import Test.Tasty.HUnit (assertEqual, assertBool, testCase) +import Test.Tasty.HUnit (assertEqual, testCase) import TestHelpers (clearDatabase, runServerPart, runServerPartWithProgramQuery, withDatabase) + +-- | Arbitrary timestamp for tests +testTimestamp :: UTCTime +testTimestamp = read "2025-10-01 17:47:27.910498 UTC" -- | List of test cases as (label, programs to insert, query params, expected output) -retrieveprogramTestCases :: [(String, [T.Text], T.Text , String)] +retrieveprogramTestCases :: [(String, [T.Text], T.Text, String)] retrieveprogramTestCases = [ ("Valid program code returns JSON" , ["ASMAJ1689"] - , T.pack "ASMAJ1689" - , "\"postCode\":\"ASMAJ1689\"" + , "ASMAJ1689" + , "{\"postCode\":\"ASMAJ1689\",\"postCreated\":\"2025-10-01T17:47:27.910498Z\",\"postDepartment\":\"test\",\"postDescription\":\"test\",\"postModified\":\"2025-10-01T17:47:27.910498Z\",\"postName\":\"Other\",\"postRequirements\":\"test\"}" ) , ("Invalid program code returns null JSON" , [] - , T.pack "INVALID123" + , "INVALID123" , "null" ) - , ("Empty code parameter returns error" + , ("Empty code parameter returns null" , [] - , T.pack "" - , "ERROR" + , "" + , "null" ) ] @@ -53,14 +55,7 @@ runRetrieveProgramTest label posts queryParam expected = response <- runServerPartWithProgramQuery Controllers.Program.retrieveProgram (T.unpack queryParam) let actual = BL.unpack $ rsBody response - case expected of - "null" -> - assertEqual ("Unexpected body for " ++ label) "null" actual - "ERROR" -> - assertBool ("Expected error body for " ++ label) (not (null actual)) - substr -> - assertBool ("Expected substring not found for " ++ label) - (substr `isInfixOf` actual) + assertEqual ("Unexpected body for " ++ label) expected actual -- | Run all the retrieveProgram test cases runRetrieveProgramTests :: [TestTree] @@ -91,9 +86,8 @@ insertPrograms :: [T.Text] -> SqlPersistM () insertPrograms = mapM_ insertProgram where insertProgram :: T.Text -> SqlPersistM () - insertProgram code = do - curr <- liftIO getCurrentTime - insert_ (Post Other "test" code "test" "test" curr curr) + insertProgram code = + insert_ (Post Other "test" code "test" "test" testTimestamp testTimestamp) -- | Run all the index test cases runIndexTests :: [TestTree] From d35686cbeeef6af5f62f600a8be05fe2646a240b Mon Sep 17 00:00:00 2001 From: japleenkaur Date: Wed, 8 Oct 2025 00:40:33 -0400 Subject: [PATCH 4/4] parsed json to not include the timestamp --- .../Controllers/ProgramControllerTests.hs | 49 +++++++++++++++---- 1 file changed, 39 insertions(+), 10 deletions(-) diff --git a/backend-test/Controllers/ProgramControllerTests.hs b/backend-test/Controllers/ProgramControllerTests.hs index 3eb888a0c..79f6d35ea 100644 --- a/backend-test/Controllers/ProgramControllerTests.hs +++ b/backend-test/Controllers/ProgramControllerTests.hs @@ -10,28 +10,44 @@ module Controllers.ProgramControllerTests ( import Config (runDb) import Controllers.Program (index, retrieveProgram) +import Control.Monad.IO.Class (liftIO) +import Data.Aeson (FromJSON (parseJSON), decode, withObject, (.:)) import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Text as T -import Data.Time (UTCTime) +import Data.Time (getCurrentTime) import Database.DataType (PostType (..)) import Database.Persist.Sqlite (SqlPersistM, insert_) import Database.Tables (Post (..)) import Happstack.Server (rsBody) import Test.Tasty (TestTree) -import Test.Tasty.HUnit (assertEqual, testCase) +import Test.Tasty.HUnit (assertBool, assertEqual, testCase) import TestHelpers (clearDatabase, runServerPart, runServerPartWithProgramQuery, withDatabase) --- | Arbitrary timestamp for tests -testTimestamp :: UTCTime -testTimestamp = read "2025-10-01 17:47:27.910498 UTC" - +-- | A Post response without timestamps (for comparison purposes) +data PostResponseNoTime = PostResponseNoTime + { postCode :: T.Text + , postDepartment :: T.Text + , postDescription :: T.Text + , postName :: T.Text + , postRequirements :: T.Text + } deriving (Show, Eq) + +instance FromJSON PostResponseNoTime where + parseJSON = withObject "Expected Object for Post" $ \o -> do + code <- o .: "postCode" + dept <- o .: "postDepartment" + desc <- o .: "postDescription" + name <- o .: "postName" + reqs <- o .: "postRequirements" + return $ PostResponseNoTime code dept desc name reqs + -- | List of test cases as (label, programs to insert, query params, expected output) retrieveprogramTestCases :: [(String, [T.Text], T.Text, String)] retrieveprogramTestCases = [ ("Valid program code returns JSON" , ["ASMAJ1689"] , "ASMAJ1689" - , "{\"postCode\":\"ASMAJ1689\",\"postCreated\":\"2025-10-01T17:47:27.910498Z\",\"postDepartment\":\"test\",\"postDescription\":\"test\",\"postModified\":\"2025-10-01T17:47:27.910498Z\",\"postName\":\"Other\",\"postRequirements\":\"test\"}" + , "{\"postCode\":\"ASMAJ1689\",\"postDepartment\":\"test\",\"postDescription\":\"test\",\"postName\":\"Other\",\"postRequirements\":\"test\"}" ) , ("Invalid program code returns null JSON" , [] @@ -45,6 +61,10 @@ retrieveprogramTestCases = ) ] +-- | Parse response and extract non-timestamp fields +parsePostResponse :: String -> Maybe PostResponseNoTime +parsePostResponse jsonStr = decode (BL.pack jsonStr) + -- | Run a test case (case, input, expected output) on the retrieveProgram function. runRetrieveProgramTest :: String -> [T.Text] -> T.Text -> String -> TestTree runRetrieveProgramTest label posts queryParam expected = @@ -55,7 +75,15 @@ runRetrieveProgramTest label posts queryParam expected = response <- runServerPartWithProgramQuery Controllers.Program.retrieveProgram (T.unpack queryParam) let actual = BL.unpack $ rsBody response - assertEqual ("Unexpected body for " ++ label) expected actual + let parsedActual = parsePostResponse actual + let parsedExpected = parsePostResponse expected + + assertBool + ("JSON mismatch for " ++ label ++ + "\nExpected: " ++ show parsedExpected ++ + "\nActual: " ++ show parsedActual ++ + "\nRaw JSON: " ++ actual) + (parsedActual == parsedExpected) -- | Run all the retrieveProgram test cases runRetrieveProgramTests :: [TestTree] @@ -86,8 +114,9 @@ insertPrograms :: [T.Text] -> SqlPersistM () insertPrograms = mapM_ insertProgram where insertProgram :: T.Text -> SqlPersistM () - insertProgram code = - insert_ (Post Other "test" code "test" "test" testTimestamp testTimestamp) + insertProgram code = do + curr <- liftIO getCurrentTime + insert_ (Post Other "test" code "test" "test" curr curr) -- | Run all the index test cases runIndexTests :: [TestTree]