ReviewBoard-0.2: Tests/TestsWithServer.hs

-----------------------------------------------------------------------------
-- | 
-- 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