----------------------------------------------------------------------------- -- | -- This tests require ReviewBoard server -- -- POC test with server. More to come... -- ----------------------------------------------------------------------------- module Tests.TestsWithServer ( apiServerTests ) where import Test.HUnit import ReviewBoard.Api import qualified ReviewBoard.Response as R import Control.Monad.Trans import Control.Monad.Error apiServerTests url user passwd = TestList [ TestLabel "Test repositoryList" $ runServerTest url user passwd repositoryListAction -- User tests , TestLabel "Test userList" $ runServerTest url user passwd (userListAction user) , TestLabel "Test userList search" $ runServerTest url user passwd (userListSearchAction user) ] -- Test repositoryList repositoryListAction :: RBAction () repositoryListAction = do setErrorHandler error r <- repositoryList >>= return . jsValue assertTrue "Repository list empty" ((length . R.repositories $ r) > 0) return () -- --------------------------------------------------------------------------- -- User API tests -- Test userList userListAction :: String -> RBAction () userListAction user = do setErrorHandler error r <- userList Nothing >>= return . jsValue let users = R.users r assertTrue "User list empty" (length users > 0) assertTrue "Login user does not exist" ((length . filter (==user) . map R.username) users > 0) return () -- Test userList search userListSearchAction :: String -> RBAction () userListSearchAction user = do setErrorHandler error vr <- userList (Just user) >>= return . jsValue assertTrue "User list is not empty" (length (R.users vr) == 1) assertTrue "No login user found" (((R.username . (!!0) . R.users) vr) == user) ir <- userList (Just "not_a_user_2345234") >>= return . jsValue assertTrue "User list is not empty" (length (R.users ir) == 0) return () -- --------------------------------------------------------------------------- -- Util function -- | General test action runner -- runServerTest :: String -> String -> String -> RBAction () -> Test runServerTest url user passwd action = TestCase ( execRBAction url user passwd action ) -- | Assert for RBAction -- assertTrue :: String -> Bool -> RBAction() assertTrue s True = return () assertTrue s False = throwError $ "Assertion: " ++ s -- | Get JSValue from respnse -- jsValue (RBok r) = r jsValue (RBerr e) = error e