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