CreateUserTest.hs

{-
  This a separate part of the high-level test of the hackage server
  (see HighLevelTest.hs). This set of tests check that the user self
  registration wors. This test needs local outgoing email, which isn't
  available on all hosts, so we keep it as a separate test.

  System requirements:

  1. Port `testPort` (currently 8392) must be available on localhost
  2. You must have sendmail configured so that it can send emails to external
     domains (for user registration) -- currently we use mailinator.com accounts
  3. You must allow for outgoing HTTP traffic, as we POST to html5.validator.nu
     for HTML validation.
-}

module Main (main) where

import Control.Exception
import Control.Monad
import Data.List (isInfixOf)
import Data.String ()
import System.Directory
import System.FilePath
import System.IO
import System.Random

import MailUtils
import Util
import HttpUtils (Authorization(..))
import HackageClientUtils

main :: IO ()
main = do hSetBuffering stdout LineBuffering
          info "Initialising"
          root <- getCurrentDirectory
          info "Setting up test directory"
          exists <- doesDirectoryExist (testDir root)
          when exists $ removeDirectoryRecursive (testDir root)
          createDirectory (testDir root)
          (setCurrentDirectory (testDir root) >> doit root)
              `finally` removeDirectoryRecursive (testDir root)

testName :: FilePath
testName = "CreateUserTestTemp"

testDir :: FilePath -> FilePath
testDir root = root </> "tests" </> testName

doit :: FilePath -> IO ()
doit root
    = do info "initialising hackage database"
         runServerChecked root ["init"]
         withServerRunning root runUserTests

runUserTests :: IO ()
runUserTests = do
    do info "Getting user list"
       xs <- getUsers
       unless (xs == ["admin"]) $
           die ("Bad user list: " ++ show xs)
    do info "Getting admin user list"
       xs <- getAdmins
       unless (groupMembers xs == ["admin"]) $
           die ("Bad admin user list: " ++ show xs)

    testEmail1 <- do
       -- Create random test email addresses so that we don't confuse
       -- confirmation emails from other sessions
       testEmail1 <- mkTestEmail `liftM` randomIO
       testEmail2 <- mkTestEmail `liftM` randomIO
       createUserSelfRegister "HackageTestUser1" "Test User 1" testEmail1
       createUserSelfRegister "HackageTestUser2" "Test User 2" testEmail2
       confirmUser testEmail1 "testpass1"
       confirmUser testEmail2 "testpass2"
       return (testEmailAddress testEmail1)
    do info "Checking new users are now in user list"
       xs <- getUsers
       unless (xs == ["admin","HackageTestUser1","HackageTestUser2"]) $
           die ("Bad user list: " ++ show xs)
    do info "Checking new users are not in admin list"
       xs <- getAdmins
       unless (groupMembers xs == ["admin"]) $
           die ("Bad admin user list: " ++ show xs)
    do info "Checking new users name & contact info"
       ncinf <- getNameContactInfo (Auth "HackageTestUser1" "testpass1")
                                   "/user/HackageTestUser1/name-contact.json"
       unless (realName ncinf == "Test User 1") $
           die ("Bad user real name: " ++ realName ncinf)
       unless (contactEmailAddress ncinf == testEmail1) $
           die ("Bad user email: " ++ contactEmailAddress ncinf)
    do info "Checking new users admin info"
       uainf <- getUserAdminInfo (Auth "admin" "admin") "/user/HackageTestUser1/admin-info.json"
       unless (accountKind uainf == Just "AccountKindRealUser") $
           die ("Bad user account kind: " ++ show (accountKind uainf))
       unless ("self-registration" `isInfixOf` accountNotes uainf) $
           die ("Bad user notes: " ++ accountNotes uainf)
       
  where
    mkTestEmail :: Int -> String
    mkTestEmail n = "HackageTestUser" ++ show n