1{-# LANGUAGE OverloadedStrings #-} 2module Main ( 3 main 4) where 5 6import Control.Exception 7import Control.Monad (when) 8 9import System.Exit 10 11import Text.Show.Pretty ( ppShow ) 12 13import Data.Monoid ((<>)) 14import qualified Data.Sequence as Seq 15 16import Test.Tasty 17 18import Network.Mattermost.Types 19import Network.Mattermost.Types.Config 20import Network.Mattermost.WebSocket.Types 21import Network.Mattermost.Exceptions 22 23import Tests.Util 24import Tests.Types 25 26main :: IO () 27main = defaultMain tests `catch` \(JSONDecodeException msg badJson) -> do 28 putStrLn $ "JSONDecodeException: " ++ msg 29 putStrLn badJson 30 exitFailure 31 32-- Users and other test configuration data 33 34testConfig :: TestConfig 35testConfig = TestConfig 36 { configUsername = "testAdmin" 37 , configEmail = "testAdmin@example.com" 38 , configHostname = "localhost" 39 , configTeam = "testteam" 40 , configPort = 8065 41 , configPassword = "password" 42 } 43 44testUserLogin :: Login 45testUserLogin = Login 46 { username = "test-user" 47 , password = "password" 48 } 49 50testMinChannel :: TeamId -> MinChannel 51testMinChannel tId = MinChannel 52 { minChannelName = "test-channel" 53 , minChannelDisplayName = "Test Channel" 54 , minChannelPurpose = Just "A channel for test cases" 55 , minChannelHeader = Just "Test Header" 56 , minChannelType = Ordinary 57 , minChannelTeamId = tId 58 } 59 60testMinChannelName :: UserText 61testMinChannelName = UserText "test-channel" 62 63 64testTeamsCreate :: TeamsCreate 65testTeamsCreate = TeamsCreate 66 { teamsCreateDisplayName = "Test Team" 67 , teamsCreateName = "testteam" 68 , teamsCreateType = Ordinary 69 } 70 71testAccount :: UsersCreate 72testAccount = 73 UsersCreate { usersCreateEmail = "test-user@example.com" 74 , usersCreatePassword = password testUserLogin 75 , usersCreateUsername = username testUserLogin 76 , usersCreateAllowMarketing = False 77 } 78 79-- Test groups 80 81tests :: TestTree 82tests = testGroup "Tests" 83 [ setup 84 , unitTests 85 ] 86 87-- Note that the order of the tests matters as each may have side 88-- effects on which subsequent tests depend. 89unitTests :: TestTree 90unitTests = testGroup "Units" 91 [ loginAsNormalUserTest 92 , initialLoadTest 93 , createChannelTest 94 , getChannelsTest 95 , leaveChannelTest 96 , joinChannelTest 97 , deleteChannelTest 98 , clientConfigTest 99 ] 100 101-- Test definitions 102 103setup :: TestTree 104setup = mmTestCase "Setup" testConfig $ do 105 adminUser <- createAdminAccount 106 107 print_ "Logging into Admin account" 108 loginAdminAccount 109 110 expectWSEvent "hello" (hasWSEventType WMHello) 111 expectWSEvent "status" (isStatusChange adminUser "online") 112 113 print_ "Creating test team" 114 testTeam <- createTeam testTeamsCreate 115 116 -- Load channels so we can get the IDs of joined channels 117 chans <- getChannels testTeam 118 119 let townSquare = findChannel chans (UserText "Town Square") 120 offTopic = findChannel chans (UserText "Off-Topic") 121 122 print_ "Getting Config" 123 config <- getConfig 124 125 print_ "Saving Config" 126 -- Enable open team so that the admin can create 127 -- new users. 128 let newTeamSettings = (configTeamsettings config) { teamSettingsEnableopenserver = True } 129 newConfig = config { configTeamsettings = newTeamSettings } 130 saveConfig newConfig 131 132 expectWSEvent "admin joined town square" 133 (isPost adminUser townSquare (UserText "testadmin has joined the channel.")) 134 135 expectWSEvent "admin joined test team" 136 (isAddedToTeam adminUser testTeam) 137 138 print_ "Creating test account" 139 testUser <- createAccount testAccount 140 141 print_ "Add test user to test team" 142 teamAddUser testTeam testUser 143 144 expectWSEvent "new test user" 145 (isNewUserEvent testUser) 146 147 expectWSEvent "test user joined town square" 148 (isPost testUser townSquare (UserText "test-user has joined the channel.")) 149 150 expectWSEvent "test user joined off-topic" 151 (isPost testUser offTopic (UserText "test-user has joined the channel.")) 152 153 expectWSDone 154 155loginAsNormalUserTest :: TestTree 156loginAsNormalUserTest = 157 mmTestCase "Logging in with normal account" testConfig $ do 158 loginAccount testUserLogin 159 Just testUser <- getUserByName (username testUserLogin) 160 161 expectWSEvent "hello" (hasWSEventType WMHello) 162 expectWSEvent "status" (isStatusChange testUser "online") 163 expectWSDone 164 165initialLoadTest :: TestTree 166initialLoadTest = 167 mmTestCase "Initial Load" testConfig $ do 168 loginAccount testUserLogin 169 170 teams <- getTeams 171 print_ (ppShow (fmap teamName teams)) 172 173 expectWSEvent "hello" (hasWSEventType WMHello) 174 expectWSDone 175 176createChannelTest :: TestTree 177createChannelTest = 178 mmTestCase "Create Channel" testConfig $ do 179 loginAccount testUserLogin 180 181 testUser <- getMe 182 teams <- getTeams 183 let team Seq.:< _ = Seq.viewl teams 184 185 chan <- createChannel (testMinChannel (teamId team)) 186 print_ (ppShow chan) 187 188 expectWSEvent "hello" (hasWSEventType WMHello) 189 expectWSEvent "test user joins test channel" 190 (isPost testUser chan (UserText "test-user has joined the channel.")) 191 expectWSEvent "new channel event" (isChannelCreatedEvent chan) 192 expectWSDone 193 194getChannelsTest :: TestTree 195getChannelsTest = 196 mmTestCase "Get Channels" testConfig $ do 197 loginAccount testUserLogin 198 teams <- getTeams 199 let team Seq.:< _ = Seq.viewl teams 200 chans <- getChannels team 201 202 let chan Seq.:< _ = Seq.viewl chans 203 print_ (ppShow chan) 204 205 expectWSEvent "hello" (hasWSEventType WMHello) 206 expectWSDone 207 208leaveChannelTest :: TestTree 209leaveChannelTest = 210 mmTestCase "Leave Channel" testConfig $ do 211 loginAccount testUserLogin 212 Just testUser <- getUserByName (username testUserLogin) 213 teams <- getTeams 214 215 let team Seq.:< _ = Seq.viewl teams 216 chans <- getChannels team 217 print_ (ppShow chans) 218 219 let chan = findChannel chans $ testMinChannelName 220 leaveChannel chan 221 222 expectWSEvent "hello" (hasWSEventType WMHello) 223 expectWSEvent "leave channel" (isUserLeave testUser chan) 224 expectWSDone 225 226joinChannelTest :: TestTree 227joinChannelTest = 228 mmTestCase "Join Channel" testConfig $ do 229 loginAccount testUserLogin 230 Just testUser <- getUserByName (username testUserLogin) 231 teams <- getTeams 232 233 let team Seq.:< _ = Seq.viewl teams 234 chans <- getChannels team 235 print_ (ppShow chans) 236 237 let chan = findChannel chans $ testMinChannelName 238 joinChannel testUser chan 239 240 members <- getChannelMembers chan 241 let expected :: [User] 242 expected = [testUser] 243 when (fmap userId members /= fmap userId expected) $ 244 error $ "Expected channel members: " <> show expected <> "\ngot: " <> show members 245 246 expectWSEvent "hello" (hasWSEventType WMHello) 247 expectWSEvent "join channel" (isUserJoin testUser chan) 248 expectWSEvent "join post" 249 (isPost testUser chan (UserText "test-user has joined the channel.")) 250 expectWSEvent "view channel" isViewedChannel 251 expectWSDone 252 253deleteChannelTest :: TestTree 254deleteChannelTest = 255 mmTestCase "Delete Channel" testConfig $ do 256 loginAccount testUserLogin 257 Just testUser <- getUserByName (username testUserLogin) 258 259 teams <- getTeams 260 let team Seq.:< _ = Seq.viewl teams 261 chans <- getChannels team 262 263 let toDelete = findChannel chans (testMinChannelName) 264 265 deleteChannel toDelete 266 267 expectWSEvent "hello" (hasWSEventType WMHello) 268 269 expectWSEvent "channel deletion post" 270 (isPost testUser toDelete (UserText "test-user has archived the channel.")) 271 272 expectWSEvent "channel delete event" 273 (isChannelDeleteEvent toDelete) 274 275 expectWSDone 276 277clientConfigTest :: TestTree 278clientConfigTest = 279 mmTestCase "Client Config Test" testConfig $ do 280 loginAccount testUserLogin 281 282 print_ "Getting Client Config" 283 config <- getClientConfig 284 285 print_ (ppShow config) 286 287 return () 288 289 -- let Object config = configObj 290 291 -- keyAssert "AboutLink" config 292 -- keyAssert "EnableSignInWithEmail" config 293 -- keyAssert "RestrictPrivateChannelCreation" config 294 -- keyAssert "SiteName" config 295 -- keyAssert "TermsOfServiceLink" config 296 -- keyAssert "WebsocketSecurePort" config 297 298 -- where 299 -- keyAssert k c = unless (HM.member k c) $ 300 -- let m = T.unpack k <> " key not present" 301 -- in print_ m 302 -- >> error m 303