1{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE MultiWayIf #-}
3module Matterhorn.State.Channels
4  ( updateViewed
5  , refreshChannel
6  , refreshChannelsAndUsers
7  , setFocus
8  , refreshChannelById
9  , applyPreferenceChange
10  , leaveChannel
11  , leaveCurrentChannel
12  , getNextUnreadChannel
13  , getNextUnreadUserOrChannel
14  , nextUnreadChannel
15  , nextUnreadUserOrChannel
16  , createOrFocusDMChannel
17  , prevChannel
18  , nextChannel
19  , recentChannel
20  , setReturnChannel
21  , resetReturnChannel
22  , hideDMChannel
23  , createGroupChannel
24  , showGroupChannelPref
25  , channelHistoryForward
26  , channelHistoryBackward
27  , handleNewChannel
28  , createOrdinaryChannel
29  , handleChannelInvite
30  , addUserByNameToCurrentChannel
31  , addUserToCurrentChannel
32  , removeUserFromCurrentChannel
33  , removeChannelFromState
34  , isRecentChannel
35  , isReturnChannel
36  , isCurrentChannel
37  , deleteCurrentChannel
38  , startLeaveCurrentChannel
39  , joinChannel
40  , joinChannel'
41  , joinChannelByName
42  , changeChannelByName
43  , setChannelTopic
44  , getCurrentChannelTopic
45  , beginCurrentChannelDeleteConfirm
46  , toggleExpandedChannelTopics
47  , updateChannelNotifyProps
48  , renameChannelUrl
49  , toggleChannelFavoriteStatus
50  )
51where
52
53import           Prelude ()
54import           Matterhorn.Prelude
55
56import           Brick.Main ( viewportScroll, vScrollToBeginning
57                            , invalidateCache, invalidateCacheEntry )
58import           Brick.Widgets.Edit ( applyEdit, getEditContents, editContentsL )
59import           Control.Concurrent.Async ( runConcurrently, Concurrently(..) )
60import           Control.Exception ( SomeException, try )
61import           Data.Char ( isAlphaNum )
62import qualified Data.HashMap.Strict as HM
63import qualified Data.Foldable as F
64import           Data.List ( nub )
65import           Data.Maybe ( fromJust )
66import qualified Data.Set as S
67import qualified Data.Sequence as Seq
68import qualified Data.Text as T
69import           Data.Text.Zipper ( textZipper, clearZipper, insertMany, gotoEOL )
70import           Data.Time.Clock ( getCurrentTime )
71import           Lens.Micro.Platform
72
73import qualified Network.Mattermost.Endpoints as MM
74import           Network.Mattermost.Lenses
75import           Network.Mattermost.Types
76
77import           Matterhorn.Constants ( normalChannelSigil )
78import           Matterhorn.InputHistory
79import           Matterhorn.State.Common
80import {-# SOURCE #-} Matterhorn.State.Messages ( fetchVisibleIfNeeded )
81import           Matterhorn.State.ChannelList
82import           Matterhorn.State.Users
83import           Matterhorn.State.Flagging
84import           Matterhorn.Types
85import           Matterhorn.Types.Common
86import           Matterhorn.Zipper ( Zipper )
87import qualified Matterhorn.Zipper as Z
88
89
90updateViewed :: Bool -> MH ()
91updateViewed updatePrev = do
92    csCurrentChannel.ccInfo.cdMentionCount .= 0
93    tId <- use csCurrentTeamId
94    updateViewedChan updatePrev =<< use (csCurrentChannelId tId)
95
96-- | When a new channel has been selected for viewing, this will
97-- notify the server of the change, and also update the local channel
98-- state to set the last-viewed time for the previous channel and
99-- update the viewed time to now for the newly selected channel.
100--
101-- The boolean argument indicates whether the view time of the previous
102-- channel (if any) should be updated, too. We typically want to do that
103-- only on channel switching; when we just want to update the view time
104-- of the specified channel, False should be provided.
105updateViewedChan :: Bool -> ChannelId -> MH ()
106updateViewedChan updatePrev cId = use csConnectionStatus >>= \case
107    -- Only do this if we're connected to avoid triggering noisy
108    -- exceptions.
109    Connected -> do
110        withChannel cId $ \chan -> do
111            pId <- if updatePrev
112                   then do
113                       case chan^.ccInfo.cdTeamId of
114                           Just tId -> use (csTeam(tId).tsRecentChannel)
115                           Nothing -> use (csCurrentTeam.tsRecentChannel)
116                   else return Nothing
117            doAsyncChannelMM Preempt cId
118              (\s c -> MM.mmViewChannel UserMe c pId s)
119              (\c () -> Just $ setLastViewedFor pId c)
120    Disconnected ->
121        -- Cannot update server; make no local updates to avoid getting
122        -- out of sync with the server. Assumes that this is a temporary
123        -- break in connectivity and that after the connection is
124        -- restored, the user's normal activities will update state as
125        -- appropriate. If connectivity is permanently lost, managing
126        -- this state is irrelevant.
127        return ()
128
129toggleExpandedChannelTopics :: MH ()
130toggleExpandedChannelTopics = do
131    mh invalidateCache
132    csResources.crConfiguration.configShowExpandedChannelTopicsL %= not
133
134-- | If the current channel is a DM channel with a single user or a
135-- group of users, hide it from the sidebar and adjust the server-side
136-- preference to hide it persistently. Note that this does not actually
137-- hide the channel in our UI; we hide it in response to the preference
138-- change websocket event triggered by this function's API interaction
139-- with the server.
140--
141-- If the current channel is any other kind of channel, complain with a
142-- usage error.
143hideDMChannel :: ChannelId -> MH ()
144hideDMChannel cId = do
145    me <- gets myUser
146    session <- getSession
147    withChannel cId $ \chan -> do
148        case chan^.ccInfo.cdType of
149            Direct -> do
150                let pref = showDirectChannelPref (me^.userIdL) uId False
151                    Just uId = chan^.ccInfo.cdDMUserId
152                csChannel(cId).ccInfo.cdSidebarShowOverride .= Nothing
153                doAsyncWith Preempt $ do
154                    MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session
155                    return Nothing
156            Group -> do
157                let pref = hideGroupChannelPref cId (me^.userIdL)
158                csChannel(cId).ccInfo.cdSidebarShowOverride .= Nothing
159                doAsyncWith Preempt $ do
160                    MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session
161                    return Nothing
162            _ -> do
163                mhError $ GenericError "Cannot hide this channel. Consider using /leave instead."
164
165-- | Called on async completion when the currently viewed channel has
166-- been updated (i.e., just switched to this channel) to update local
167-- state.
168setLastViewedFor :: Maybe ChannelId -> ChannelId -> MH ()
169setLastViewedFor prevId cId = do
170    chan <- use (csChannels.to (findChannelById cId))
171    -- Update new channel's viewed time, creating the channel if needed
172    case chan of
173        Nothing ->
174            -- It's possible for us to get spurious WMChannelViewed
175            -- events from the server, e.g. for channels that have been
176            -- deleted. So here we ignore the request since it's hard to
177            -- detect it before this point.
178            return ()
179        Just _  ->
180          -- The server has been sent a viewed POST update, but there is
181          -- no local information on what timestamp the server actually
182          -- recorded. There are a couple of options for setting the
183          -- local value of the viewed time:
184          --
185          --   1. Attempting to locally construct a value, which would
186          --      involve scanning all (User) messages in the channel
187          --      to find the maximum of the created date, the modified
188          --      date, or the deleted date, and assuming that maximum
189          --      mostly matched the server's viewed time.
190          --
191          --   2. Issuing a channel metadata request to get the server's
192          --      new concept of the viewed time.
193          --
194          --   3. Having the "chan/viewed" POST that was just issued
195          --      return a value from the server. See
196          --      https://github.com/mattermost/platform/issues/6803.
197          --
198          -- Method 3 would be the best and most lightweight. Until that
199          -- is available, Method 2 will be used. The downside to Method
200          -- 2 is additional client-server messaging, and a delay in
201          -- updating the client data, but it's also immune to any new
202          -- or removed Message date fields, or anything else that would
203          -- contribute to the viewed/updated times on the server.
204          doAsyncChannelMM Preempt cId (\ s _ ->
205                                           (,) <$> MM.mmGetChannel cId s
206                                               <*> MM.mmGetChannelMember cId UserMe s)
207          (\pcid (cwd, member) -> Just $ csChannel(pcid).ccInfo %= channelInfoFromChannelWithData cwd member)
208
209    -- Update the old channel's previous viewed time (allows tracking of
210    -- new messages)
211    case prevId of
212      Nothing -> return ()
213      Just p -> clearChannelUnreadStatus p
214
215-- | Refresh information about all channels and users. This is usually
216-- triggered when a reconnect event for the WebSocket to the server
217-- occurs.
218refreshChannelsAndUsers :: MH ()
219refreshChannelsAndUsers = do
220    session <- getSession
221    me <- gets myUser
222    knownUsers <- gets allUserIds
223    ts <- use csTeams
224    doAsyncWith Preempt $ do
225      pairs <- forM (HM.keys ts) $ \tId -> do
226          runConcurrently $ (,)
227              <$> Concurrently (MM.mmGetChannelsForUser UserMe tId session)
228              <*> Concurrently (MM.mmGetChannelMembersForUser UserMe tId session)
229
230      let (chans, datas) = (mconcat $ fst <$> pairs, mconcat $ snd <$> pairs)
231
232      -- Collect all user IDs associated with DM channels so we can
233      -- bulk-fetch their user records.
234      let dmUsers = catMaybes $ flip map (F.toList chans) $ \chan ->
235              case chan^.channelTypeL of
236                  Direct -> case userIdForDMChannel (userId me) (sanitizeUserText $ channelName chan) of
237                        Nothing -> Nothing
238                        Just otherUserId -> Just otherUserId
239                  _ -> Nothing
240          uIdsToFetch = nub $ userId me : knownUsers <> dmUsers
241
242          dataMap = HM.fromList $ toList $ (\d -> (channelMemberChannelId d, d)) <$> datas
243          mkPair chan = (chan, fromJust $ HM.lookup (channelId chan) dataMap)
244          chansWithData = mkPair <$> chans
245
246      return $ Just $
247          -- Fetch user data associated with DM channels
248          handleNewUsers (Seq.fromList uIdsToFetch) $ do
249              -- Then refresh all loaded channels
250              forM_ chansWithData $ uncurry (refreshChannel SidebarUpdateDeferred)
251              updateSidebar Nothing
252
253-- | Refresh information about a specific channel.  The channel
254-- metadata is refreshed, and if this is a loaded channel, the
255-- scrollback is updated as well.
256--
257-- The sidebar update argument indicates whether this refresh should
258-- also update the sidebar. Ordinarily you want this, so pass
259-- SidebarUpdateImmediate unless you are very sure you know what you are
260-- doing, i.e., you are very sure that a call to refreshChannel will
261-- be followed immediately by a call to updateSidebar. We provide this
262-- control so that channel refreshes can be batched and then a single
263-- updateSidebar call can be used instead of the default behavior of
264-- calling it once per refreshChannel call, which is the behavior if the
265-- immediate setting is passed here.
266refreshChannel :: SidebarUpdate -> Channel -> ChannelMember -> MH ()
267refreshChannel upd chan member = do
268    ts <- use csTeams
269    let ourTeams = HM.keys ts
270        isOurTeam = case channelTeamId chan of
271            Nothing -> True
272            Just tId -> tId `elem` ourTeams
273
274    case isOurTeam of
275        False -> return ()
276        True -> do
277            let cId = getId chan
278            -- If this channel is unknown, register it first.
279            mChan <- preuse (csChannel(cId))
280            when (isNothing mChan) $
281                handleNewChannel False upd chan member
282
283            updateChannelInfo cId chan member
284
285handleNewChannel :: Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
286handleNewChannel = handleNewChannel_ True
287
288handleNewChannel_ :: Bool
289                  -- ^ Whether to permit this call to recursively
290                  -- schedule itself for later if it can't locate
291                  -- a DM channel user record. This is to prevent
292                  -- uncontrolled recursion.
293                  -> Bool
294                  -- ^ Whether to switch to the new channel once it has
295                  -- been installed.
296                  -> SidebarUpdate
297                  -- ^ Whether to update the sidebar, in case the caller
298                  -- wants to batch these before updating it. Pass
299                  -- SidebarUpdateImmediate unless you know what
300                  -- you are doing, i.e., unless you intend to call
301                  -- updateSidebar yourself after calling this.
302                  -> Channel
303                  -- ^ The channel to install.
304                  -> ChannelMember
305                  -> MH ()
306handleNewChannel_ permitPostpone switch sbUpdate nc member = do
307    -- Only add the channel to the state if it isn't already known.
308    me <- gets myUser
309    mChan <- preuse (csChannel(getId nc))
310    case mChan of
311        Just _ -> when switch $ setFocus (getId nc)
312        Nothing -> do
313            -- Create a new ClientChannel structure
314            cChannel <- (ccInfo %~ channelInfoFromChannelWithData nc member) <$>
315                       makeClientChannel (me^.userIdL) nc
316
317            st <- use id
318
319            -- Add it to the message map, and to the name map so we
320            -- can look it up by name. The name we use for the channel
321            -- depends on its type:
322            let chType = nc^.channelTypeL
323
324            -- Get the channel name. If we couldn't, that means we have
325            -- async work to do before we can register this channel (in
326            -- which case abort because we got rescheduled).
327            register <- case chType of
328                Direct -> case userIdForDMChannel (myUserId st) (sanitizeUserText $ channelName nc) of
329                    Nothing -> return True
330                    Just otherUserId ->
331                        case userById otherUserId st of
332                            -- If we found a user ID in the channel
333                            -- name string but don't have that user's
334                            -- metadata, postpone adding this channel
335                            -- until we have fetched the metadata. This
336                            -- can happen when we have a channel record
337                            -- for a user that is no longer in the
338                            -- current team. To avoid recursion due to a
339                            -- problem, ensure that the rescheduled new
340                            -- channel handler is not permitted to try
341                            -- this again.
342                            --
343                            -- If we're already in a recursive attempt
344                            -- to register this channel and still
345                            -- couldn't find a username, just bail and
346                            -- use the synthetic name (this has the same
347                            -- problems as above).
348                            Nothing -> do
349                                case permitPostpone of
350                                    False -> return True
351                                    True -> do
352                                        mhLog LogAPI $ T.pack $ "handleNewChannel_: about to call handleNewUsers for " <> show otherUserId
353                                        handleNewUsers (Seq.singleton otherUserId) (return ())
354                                        doAsyncWith Normal $
355                                            return $ Just $ handleNewChannel_ False switch sbUpdate nc member
356                                        return False
357                            Just _ -> return True
358                _ -> return True
359
360            when register $ do
361                csChannels %= addChannel (getId nc) cChannel
362                when (sbUpdate == SidebarUpdateImmediate) $ do
363                    -- Note that we only check for whether we should
364                    -- switch to this channel when doing a sidebar
365                    -- update, since that's the only case where it's
366                    -- possible to do so.
367                    updateSidebar (cChannel^.ccInfo.cdTeamId)
368
369                    -- Finally, set our focus to the newly created
370                    -- channel if the caller requested a change of
371                    -- channel. Also consider the last join request
372                    -- state field in case this is an asynchronous
373                    -- channel addition triggered by a /join.
374                    pending1 <- checkPendingChannelChange (getId nc)
375                    pending2 <- case cChannel^.ccInfo.cdDMUserId of
376                        Nothing -> return False
377                        Just uId -> checkPendingChannelChangeByUserId uId
378
379                    when (switch || isJust pending1 || pending2) $ do
380                        setFocus (getId nc)
381                        case pending1 of
382                            Just (Just act) -> act
383                            _ -> return ()
384
385-- | Check to see whether the specified channel has been queued up to
386-- be switched to.  Note that this condition is only cleared by the
387-- actual setFocus switch to the channel because there may be multiple
388-- operations that must complete before the channel is fully ready for
389-- display/use.
390--
391-- Returns Just if the specified channel has a pending switch. The
392-- result is an optional action to invoke after changing to the
393-- specified channel.
394checkPendingChannelChange :: ChannelId -> MH (Maybe (Maybe (MH ())))
395checkPendingChannelChange cId = do
396    ch <- use (csCurrentTeam.tsPendingChannelChange)
397    curTid <- use csCurrentTeamId
398    return $ case ch of
399        Just (ChangeByChannelId tId i act) ->
400            if i == cId && curTid == tId then Just act else Nothing
401        _ -> Nothing
402
403-- | Check to see whether the specified channel has been queued up to
404-- be switched to.  Note that this condition is only cleared by the
405-- actual setFocus switch to the channel because there may be multiple
406-- operations that must complete before the channel is fully ready for
407-- display/use.
408--
409-- Returns Just if the specified channel has a pending switch. The
410-- result is an optional action to invoke after changing to the
411-- specified channel.
412checkPendingChannelChangeByUserId :: UserId -> MH Bool
413checkPendingChannelChangeByUserId uId = do
414    ch <- use (csCurrentTeam.tsPendingChannelChange)
415    return $ case ch of
416        Just (ChangeByUserId i) ->
417            i == uId
418        _ ->
419            False
420
421-- | Update the indicated Channel entry with the new data retrieved from
422-- the Mattermost server. Also update the channel name if it changed.
423updateChannelInfo :: ChannelId -> Channel -> ChannelMember -> MH ()
424updateChannelInfo cid new member = do
425    mh $ invalidateCacheEntry $ ChannelMessages cid
426    csChannel(cid).ccInfo %= channelInfoFromChannelWithData new member
427    withChannel cid $ \chan ->
428        updateSidebar (chan^.ccInfo.cdTeamId)
429
430setFocus :: ChannelId -> MH ()
431setFocus cId = do
432    showChannelInSidebar cId True
433    setFocusWith True (Z.findRight ((== cId) . channelListEntryChannelId)) (return ())
434
435setFocusWith :: Bool
436             -> (Zipper ChannelListGroup ChannelListEntry
437             -> Zipper ChannelListGroup ChannelListEntry)
438             -> MH ()
439             -> MH ()
440setFocusWith updatePrev f onNoChange = do
441    tId <- use csCurrentTeamId
442    oldZipper <- use (csCurrentTeam.tsFocus)
443    let newZipper = f oldZipper
444        newFocus = Z.focus newZipper
445        oldFocus = Z.focus oldZipper
446
447    -- If we aren't changing anything, skip all the book-keeping because
448    -- we'll end up clobbering things like tsRecentChannel.
449    if newFocus /= oldFocus
450       then do
451          mh $ invalidateCacheEntry $ ChannelSidebar tId
452          resetAutocomplete
453          preChangeChannelCommon
454          csCurrentTeam.tsFocus .= newZipper
455
456          now <- liftIO getCurrentTime
457          newCid <- use (csCurrentChannelId tId)
458          csChannel(newCid).ccInfo.cdSidebarShowOverride .= Just now
459
460          updateViewed updatePrev
461          postChangeChannelCommon
462       else onNoChange
463
464postChangeChannelCommon :: MH ()
465postChangeChannelCommon = do
466    resetEditorState
467    updateChannelListScroll
468    loadLastEdit
469    fetchVisibleIfNeeded
470
471loadLastEdit :: MH ()
472loadLastEdit = do
473    tId <- use csCurrentTeamId
474    cId <- use (csCurrentChannelId tId)
475
476    oldEphemeral <- preuse (csChannel(cId).ccEditState)
477    case oldEphemeral of
478        Nothing -> return ()
479        Just e -> csCurrentTeam.tsEditState.cedEphemeral .= e
480
481    loadLastChannelInput
482
483loadLastChannelInput :: MH ()
484loadLastChannelInput = do
485    tId <- use csCurrentTeamId
486    cId <- use (csCurrentChannelId tId)
487    inputHistoryPos <- use (csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition)
488    case inputHistoryPos of
489        Just i -> loadHistoryEntryToEditor cId i
490        Nothing -> do
491            (lastEdit, lastEditMode) <- use (csCurrentTeam.tsEditState.cedEphemeral.eesLastInput)
492            csCurrentTeam.tsEditState.cedEditor %= (applyEdit $ insertMany lastEdit . clearZipper)
493            csCurrentTeam.tsEditState.cedEditMode .= lastEditMode
494
495updateChannelListScroll :: MH ()
496updateChannelListScroll = do
497    tId <- use csCurrentTeamId
498    mh $ vScrollToBeginning (viewportScroll $ ChannelList tId)
499
500preChangeChannelCommon :: MH ()
501preChangeChannelCommon = do
502    tId <- use csCurrentTeamId
503    cId <- use (csCurrentChannelId tId)
504    csCurrentTeam.tsRecentChannel .= Just cId
505    saveCurrentEdit
506
507resetEditorState :: MH ()
508resetEditorState = do
509    csCurrentTeam.tsEditState.cedEditMode .= NewPost
510    clearEditor
511
512clearEditor :: MH ()
513clearEditor = csCurrentTeam.tsEditState.cedEditor %= applyEdit clearZipper
514
515saveCurrentEdit :: MH ()
516saveCurrentEdit = do
517    saveCurrentChannelInput
518
519    oldEphemeral <- use (csCurrentTeam.tsEditState.cedEphemeral)
520    tId <- use csCurrentTeamId
521    cId <- use (csCurrentChannelId tId)
522    csChannel(cId).ccEditState .= oldEphemeral
523
524saveCurrentChannelInput :: MH ()
525saveCurrentChannelInput = do
526    cmdLine <- use (csCurrentTeam.tsEditState.cedEditor)
527    mode <- use (csCurrentTeam.tsEditState.cedEditMode)
528
529    -- Only save the editor contents if the user is not navigating the
530    -- history.
531    inputHistoryPos <- use (csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition)
532
533    when (isNothing inputHistoryPos) $
534        csCurrentTeam.tsEditState.cedEphemeral.eesLastInput .=
535           (T.intercalate "\n" $ getEditContents $ cmdLine, mode)
536
537applyPreferenceChange :: Preference -> MH ()
538applyPreferenceChange pref = do
539    -- always update our user preferences accordingly
540    csResources.crUserPreferences %= setUserPreferences (Seq.singleton pref)
541
542    -- Invalidate the entire rendering cache since many things depend on
543    -- user preferences
544    mh invalidateCache
545
546    if
547      | Just f <- preferenceToFlaggedPost pref -> do
548          updateMessageFlag (flaggedPostId f) (flaggedPostStatus f)
549
550      | Just tIds <- preferenceToTeamOrder pref ->
551          applyTeamOrder tIds
552
553      | Just d <- preferenceToDirectChannelShowStatus pref -> do
554          updateSidebar Nothing
555
556          cs <- use csChannels
557
558          -- We need to check on whether this preference was to show a
559          -- channel and, if so, whether it was the one we attempted to
560          -- switch to (thus triggering the preference change). If so,
561          -- we need to switch to it now.
562          let Just cId = getDmChannelFor (directChannelShowUserId d) cs
563          case directChannelShowValue d of
564              True -> do
565                  pending <- checkPendingChannelChange cId
566                  case pending of
567                      Just mAct -> do
568                          setFocus cId
569                          fromMaybe (return ()) mAct
570                      Nothing -> return ()
571              False -> do
572                  csChannel(cId).ccInfo.cdSidebarShowOverride .= Nothing
573
574      | Just g <- preferenceToGroupChannelPreference pref -> do
575          updateSidebar Nothing
576
577          -- We need to check on whether this preference was to show a
578          -- channel and, if so, whether it was the one we attempted to
579          -- switch to (thus triggering the preference change). If so,
580          -- we need to switch to it now.
581          let cId = groupChannelId g
582          case groupChannelShow g of
583              True -> do
584                  pending <- checkPendingChannelChange cId
585                  case pending of
586                      Just mAct -> do
587                          setFocus cId
588                          fromMaybe (return ()) mAct
589                      Nothing -> return ()
590              False -> do
591                  csChannel(cId).ccInfo.cdSidebarShowOverride .= Nothing
592
593      | Just f <- preferenceToFavoriteChannelPreference pref -> do
594          updateSidebar Nothing
595
596          -- We need to check on whether this preference was to show a
597          -- channel and, if so, whether it was the one we attempted to
598          -- switch to (thus triggering the preference change). If so,
599          -- we need to switch to it now.
600          let cId = favoriteChannelId f
601          case favoriteChannelShow f of
602              True -> do
603                  pending <- checkPendingChannelChange cId
604                  case pending of
605                      Just mAct -> do
606                          setFocus cId
607                          fromMaybe (return ()) mAct
608                      Nothing -> return ()
609              False -> do
610                  csChannel(cId).ccInfo.cdSidebarShowOverride .= Nothing
611      | otherwise -> return ()
612
613refreshChannelById :: ChannelId -> MH ()
614refreshChannelById cId = do
615    session <- getSession
616    doAsyncWith Preempt $ do
617        cwd <- MM.mmGetChannel cId session
618        member <- MM.mmGetChannelMember cId UserMe session
619        return $ Just $ do
620            refreshChannel SidebarUpdateImmediate cwd member
621
622removeChannelFromState :: ChannelId -> MH ()
623removeChannelFromState cId = do
624    withChannel cId $ \ chan -> do
625        when (chan^.ccInfo.cdType /= Direct) $ do
626            case chan^.ccInfo.cdTeamId of
627                Nothing -> return ()
628                Just tId -> do
629                    origFocus <- use (csCurrentChannelId tId)
630                    when (origFocus == cId) nextChannelSkipPrevView
631
632            -- Update input history
633            csInputHistory %= removeChannelHistory cId
634            -- Update msgMap
635            csChannels %= removeChannel cId
636
637            case chan^.ccInfo.cdTeamId of
638                Nothing -> do
639                    ts <- use csTeams
640                    forM_ (HM.keys ts) $ \tId ->
641                        csTeam(tId).tsFocus %= Z.filterZipper ((/= cId) . channelListEntryChannelId)
642                Just tId -> do
643                    csTeam(tId).tsFocus %= Z.filterZipper ((/= cId) . channelListEntryChannelId)
644
645            updateSidebar $ chan^.ccInfo.cdTeamId
646
647nextChannel :: MH ()
648nextChannel = do
649    resetReturnChannel
650    setFocusWith True Z.right (return ())
651
652-- | This is almost never what you want; we use this when we delete a
653-- channel and we don't want to update the deleted channel's view time.
654nextChannelSkipPrevView :: MH ()
655nextChannelSkipPrevView = setFocusWith False Z.right (return ())
656
657prevChannel :: MH ()
658prevChannel = do
659    resetReturnChannel
660    setFocusWith True Z.left (return ())
661
662recentChannel :: MH ()
663recentChannel = do
664  recent <- use (csCurrentTeam.tsRecentChannel)
665  case recent of
666    Nothing  -> return ()
667    Just cId -> do
668        ret <- use (csCurrentTeam.tsReturnChannel)
669        when (ret == Just cId) resetReturnChannel
670        setFocus cId
671
672resetReturnChannel :: MH ()
673resetReturnChannel = do
674  val <- use (csCurrentTeam.tsReturnChannel)
675  case val of
676      Nothing -> return ()
677      Just _ -> do
678          tId <- use csCurrentTeamId
679          mh $ invalidateCacheEntry $ ChannelSidebar tId
680          csCurrentTeam.tsReturnChannel .= Nothing
681
682gotoReturnChannel :: MH ()
683gotoReturnChannel = do
684  ret <- use (csCurrentTeam.tsReturnChannel)
685  case ret of
686    Nothing  -> return ()
687    Just cId -> do
688        resetReturnChannel
689        setFocus cId
690
691setReturnChannel :: MH ()
692setReturnChannel = do
693  ret <- use (csCurrentTeam.tsReturnChannel)
694  case ret of
695    Nothing  -> do
696        tId <- use csCurrentTeamId
697        cId <- use (csCurrentChannelId tId)
698        csCurrentTeam.tsReturnChannel .= Just cId
699        mh $ invalidateCacheEntry $ ChannelSidebar tId
700    Just _ -> return ()
701
702nextUnreadChannel :: MH ()
703nextUnreadChannel = do
704    st <- use id
705    setReturnChannel
706    setFocusWith True (getNextUnreadChannel st) gotoReturnChannel
707
708nextUnreadUserOrChannel :: MH ()
709nextUnreadUserOrChannel = do
710    st <- use id
711    setReturnChannel
712    setFocusWith True (getNextUnreadUserOrChannel st) gotoReturnChannel
713
714leaveChannel :: ChannelId -> MH ()
715leaveChannel cId = leaveChannelIfPossible cId False
716
717leaveChannelIfPossible :: ChannelId -> Bool -> MH ()
718leaveChannelIfPossible cId delete = do
719    st <- use id
720    me <- gets myUser
721    let isMe u = u^.userIdL == me^.userIdL
722
723    case st ^? csChannel(cId).ccInfo of
724        Nothing -> return ()
725        Just cInfo -> case canLeaveChannel cInfo of
726            False -> return ()
727            True ->
728                -- The server will reject an attempt to leave a private
729                -- channel if we're the only member. To check this, we
730                -- just ask for the first two members of the channel.
731                -- If there is only one, it must be us: hence the "all
732                -- isMe" check below. If there are two members, it
733                -- doesn't matter who they are, because we just know
734                -- that we aren't the only remaining member, so we can't
735                -- delete the channel.
736                doAsyncChannelMM Preempt cId
737                    (\s _ ->
738                      let query = MM.defaultUserQuery
739                           { MM.userQueryPage = Just 0
740                           , MM.userQueryPerPage = Just 2
741                           , MM.userQueryInChannel = Just cId
742                           }
743                      in toList <$> MM.mmGetUsers query s)
744                    (\_ members -> Just $ do
745                        -- If the channel is private:
746                        --  * leave it if we aren't the last member.
747                        --  * delete it if we are.
748                        --
749                        -- Otherwise:
750                        --  * leave (or delete) the channel as specified
751                        --    by the delete argument.
752                        let func = case cInfo^.cdType of
753                                Private -> case all isMe members of
754                                    True -> (\ s c -> MM.mmDeleteChannel c s)
755                                    False -> (\ s c -> MM.mmRemoveUserFromChannel c UserMe s)
756                                Group ->
757                                    \s _ ->
758                                        let pref = hideGroupChannelPref cId (me^.userIdL)
759                                        in MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) s
760                                _ -> if delete
761                                     then (\ s c -> MM.mmDeleteChannel c s)
762                                     else (\ s c -> MM.mmRemoveUserFromChannel c UserMe s)
763
764                        doAsyncChannelMM Preempt cId func endAsyncNOP
765                    )
766
767getNextUnreadChannel :: ChatState
768                     -> (Zipper a ChannelListEntry -> Zipper a ChannelListEntry)
769getNextUnreadChannel st =
770    -- The next channel with unread messages must also be a channel
771    -- other than the current one, since the zipper may be on a channel
772    -- that has unread messages and will stay that way until we leave
773    -- it- so we need to skip that channel when doing the zipper search
774    -- for the next candidate channel.
775    Z.findRight (\e ->
776                let cId = channelListEntryChannelId e
777                in channelListEntryUnread e && (cId /= st^.csCurrentChannelId(st^.csCurrentTeamId)))
778
779getNextUnreadUserOrChannel :: ChatState
780                           -> Zipper a ChannelListEntry
781                           -> Zipper a ChannelListEntry
782getNextUnreadUserOrChannel st z =
783    -- Find the next unread channel, prefering direct messages
784    let cur = st^.csCurrentChannelId(st^.csCurrentTeamId)
785        matches e = entryIsDMEntry e && isFresh e
786        isFresh e = channelListEntryUnread e && (channelListEntryChannelId e /= cur)
787    in fromMaybe (Z.findRight isFresh z)
788                 (Z.maybeFindRight matches z)
789
790leaveCurrentChannel :: MH ()
791leaveCurrentChannel = do
792    tId <- use csCurrentTeamId
793    use (csCurrentChannelId tId) >>= leaveChannel
794
795createGroupChannel :: Text -> MH ()
796createGroupChannel usernameList = do
797    me <- gets myUser
798    session <- getSession
799    cs <- use csChannels
800
801    doAsyncWith Preempt $ do
802        let usernames = Seq.fromList $ fmap trimUserSigil $ T.words usernameList
803        results <- MM.mmGetUsersByUsernames usernames session
804
805        -- If we found all of the users mentioned, then create the group
806        -- channel.
807        case length results == length usernames of
808            True -> do
809                chan <- MM.mmCreateGroupMessageChannel (userId <$> results) session
810                return $ Just $ do
811                    case findChannelById (channelId chan) cs of
812                      Just _ ->
813                          -- If we already know about the channel ID,
814                          -- that means the channel already exists so
815                          -- we can just switch to it.
816                          setFocus (channelId chan)
817                      Nothing -> do
818                          tId <- use csCurrentTeamId
819                          csCurrentTeam.tsPendingChannelChange .=
820                              (Just $ ChangeByChannelId tId (channelId chan) Nothing)
821                          let pref = showGroupChannelPref (channelId chan) (me^.userIdL)
822                          doAsyncWith Normal $ do
823                            MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session
824                            return $ Just $ applyPreferenceChange pref
825            False -> do
826                let foundUsernames = userUsername <$> results
827                    missingUsernames = S.toList $
828                                       S.difference (S.fromList $ F.toList usernames)
829                                                    (S.fromList $ F.toList foundUsernames)
830                return $ Just $ do
831                    forM_ missingUsernames (mhError . NoSuchUser)
832
833channelHistoryForward :: MH ()
834channelHistoryForward = do
835    resetAutocomplete
836
837    tId <- use csCurrentTeamId
838    cId <- use (csCurrentChannelId tId)
839    inputHistoryPos <- use (csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition)
840    case inputHistoryPos of
841        Just i
842          | i == 0 -> do
843            -- Transition out of history navigation
844            csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition .= Nothing
845            loadLastChannelInput
846          | otherwise -> do
847            let newI = i - 1
848            loadHistoryEntryToEditor cId newI
849            csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition .= (Just newI)
850        _ -> return ()
851
852loadHistoryEntryToEditor :: ChannelId -> Int -> MH ()
853loadHistoryEntryToEditor cId idx = do
854    inputHistory <- use csInputHistory
855    case getHistoryEntry cId idx inputHistory of
856        Nothing -> return ()
857        Just entry -> do
858            let eLines = T.lines entry
859                mv = if length eLines == 1 then gotoEOL else id
860            csCurrentTeam.tsEditState.cedEditor.editContentsL .= (mv $ textZipper eLines Nothing)
861
862channelHistoryBackward :: MH ()
863channelHistoryBackward = do
864    resetAutocomplete
865
866    tId <- use csCurrentTeamId
867    cId <- use (csCurrentChannelId tId)
868    inputHistoryPos <- use (csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition)
869    saveCurrentChannelInput
870
871    let newI = maybe 0 (+ 1) inputHistoryPos
872    loadHistoryEntryToEditor cId newI
873    csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition .= (Just newI)
874
875createOrdinaryChannel :: Bool -> Text -> MH ()
876createOrdinaryChannel public name = do
877    session <- getSession
878    myTId <- use csCurrentTeamId
879    doAsyncWith Preempt $ do
880        -- create a new chat channel
881        let slug = T.map (\ c -> if isAlphaNum c then c else '-') (T.toLower name)
882            minChannel = MinChannel
883              { minChannelName        = slug
884              , minChannelDisplayName = name
885              , minChannelPurpose     = Nothing
886              , minChannelHeader      = Nothing
887              , minChannelType        = if public then Ordinary else Private
888              , minChannelTeamId      = myTId
889              }
890        tryMM (do c <- MM.mmCreateChannel minChannel session
891                  chan <- MM.mmGetChannel (getId c) session
892                  member <- MM.mmGetChannelMember (getId c) UserMe session
893                  return (chan, member)
894              )
895              (return . Just . uncurry (handleNewChannel True SidebarUpdateImmediate))
896
897-- | When we are added to a channel not locally known about, we need
898-- to fetch the channel info for that channel.
899handleChannelInvite :: ChannelId -> MH ()
900handleChannelInvite cId = do
901    session <- getSession
902    doAsyncWith Normal $ do
903        member <- MM.mmGetChannelMember cId UserMe session
904        tryMM (MM.mmGetChannel cId session)
905              (\cwd -> return $ Just $ do
906                  pending <- checkPendingChannelChange cId
907                  handleNewChannel (isJust pending) SidebarUpdateImmediate cwd member)
908
909addUserByNameToCurrentChannel :: Text -> MH ()
910addUserByNameToCurrentChannel uname =
911    withFetchedUser (UserFetchByUsername uname) addUserToCurrentChannel
912
913addUserToCurrentChannel :: UserInfo -> MH ()
914addUserToCurrentChannel u = do
915    tId <- use csCurrentTeamId
916    cId <- use (csCurrentChannelId tId)
917    session <- getSession
918    let channelMember = MinChannelMember (u^.uiId) cId
919    doAsyncWith Normal $ do
920        tryMM (void $ MM.mmAddUser cId channelMember session)
921              (const $ return Nothing)
922
923removeUserFromCurrentChannel :: Text -> MH ()
924removeUserFromCurrentChannel uname =
925    withFetchedUser (UserFetchByUsername uname) $ \u -> do
926        tId <- use csCurrentTeamId
927        cId <- use (csCurrentChannelId tId)
928        session <- getSession
929        doAsyncWith Normal $ do
930            tryMM (void $ MM.mmRemoveUserFromChannel cId (UserById $ u^.uiId) session)
931                  (const $ return Nothing)
932
933startLeaveCurrentChannel :: MH ()
934startLeaveCurrentChannel = do
935    cInfo <- use (csCurrentChannel.ccInfo)
936    case cInfo^.cdType of
937        Direct -> hideDMChannel (cInfo^.cdChannelId)
938        Group -> hideDMChannel (cInfo^.cdChannelId)
939        _ -> setMode LeaveChannelConfirm
940
941deleteCurrentChannel :: MH ()
942deleteCurrentChannel = do
943    setMode Main
944    tId <- use csCurrentTeamId
945    cId <- use (csCurrentChannelId tId)
946    leaveChannelIfPossible cId True
947
948isCurrentChannel :: ChatState -> ChannelId -> Bool
949isCurrentChannel st cId = st^.csCurrentChannelId(st^.csCurrentTeamId) == cId
950
951isRecentChannel :: ChatState -> ChannelId -> Bool
952isRecentChannel st cId = st^.csCurrentTeam.tsRecentChannel == Just cId
953
954isReturnChannel :: ChatState -> ChannelId -> Bool
955isReturnChannel st cId = st^.csCurrentTeam.tsReturnChannel == Just cId
956
957joinChannelByName :: Text -> MH ()
958joinChannelByName rawName = do
959    session <- getSession
960    tId <- use csCurrentTeamId
961    doAsyncWith Preempt $ do
962        result <- try $ MM.mmGetChannelByName tId (trimChannelSigil rawName) session
963        return $ Just $ case result of
964            Left (_::SomeException) -> mhError $ NoSuchChannel rawName
965            Right chan -> joinChannel $ getId chan
966
967-- | If the user is not a member of the specified channel, submit a
968-- request to join it. Otherwise switch to the channel.
969joinChannel :: ChannelId -> MH ()
970joinChannel chanId = joinChannel' chanId Nothing
971
972joinChannel' :: ChannelId -> Maybe (MH ()) -> MH ()
973joinChannel' chanId act = do
974    setMode Main
975    mChan <- preuse (csChannel(chanId))
976    case mChan of
977        Just _ -> do
978            setFocus chanId
979            fromMaybe (return ()) act
980        Nothing -> do
981            myId <- gets myUserId
982            tId <- use csCurrentTeamId
983            let member = MinChannelMember myId chanId
984            csCurrentTeam.tsPendingChannelChange .= (Just $ ChangeByChannelId tId chanId act)
985            doAsyncChannelMM Preempt chanId (\ s c -> MM.mmAddUser c member s) (const $ return act)
986
987createOrFocusDMChannel :: UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
988createOrFocusDMChannel user successAct = do
989    cs <- use csChannels
990    case getDmChannelFor (user^.uiId) cs of
991        Just cId -> do
992            setFocus cId
993            case successAct of
994                Nothing -> return ()
995                Just act -> act cId
996        Nothing -> do
997            -- We have a user of that name but no channel. Time to make one!
998            myId <- gets myUserId
999            session <- getSession
1000            csCurrentTeam.tsPendingChannelChange .= (Just $ ChangeByUserId $ user^.uiId)
1001            doAsyncWith Normal $ do
1002                -- create a new channel
1003                chan <- MM.mmCreateDirectMessageChannel (user^.uiId, myId) session
1004                return $ successAct <*> pure (channelId chan)
1005
1006-- | This switches to the named channel or creates it if it is a missing
1007-- but valid user channel.
1008changeChannelByName :: Text -> MH ()
1009changeChannelByName name = do
1010    myId <- gets myUserId
1011    mCId <- gets (channelIdByChannelName name)
1012    mDMCId <- gets (channelIdByUsername name)
1013
1014    withFetchedUserMaybe (UserFetchByUsername name) $ \foundUser -> do
1015        if (_uiId <$> foundUser) == Just myId
1016        then return ()
1017        else do
1018            setMode Main
1019            let err = mhError $ AmbiguousName name
1020            case (mCId, mDMCId) of
1021              (Nothing, Nothing) ->
1022                  case foundUser of
1023                      -- We know about the user but there isn't already a DM
1024                      -- channel, so create one.
1025                      Just user -> createOrFocusDMChannel user Nothing
1026                      -- There were no matches of any kind.
1027                      Nothing -> mhError $ NoSuchChannel name
1028              (Just cId, Nothing)
1029                  -- We matched a channel and there was an explicit sigil, so we
1030                  -- don't care about the username match.
1031                  | normalChannelSigil `T.isPrefixOf` name -> setFocus cId
1032                  -- We matched both a channel and a user, even though there is
1033                  -- no DM channel.
1034                  | Just _ <- foundUser -> err
1035                  -- We matched a channel only.
1036                  | otherwise -> setFocus cId
1037              (Nothing, Just cId) ->
1038                  -- We matched a DM channel only.
1039                  setFocus cId
1040              (Just _, Just _) ->
1041                  -- We matched both a channel and a DM channel.
1042                  err
1043
1044setChannelTopic :: Text -> MH ()
1045setChannelTopic msg = do
1046    tId <- use csCurrentTeamId
1047    cId <- use (csCurrentChannelId tId)
1048    let patch = defaultChannelPatch { channelPatchHeader = Just msg }
1049    doAsyncChannelMM Preempt cId
1050        (\s _ -> MM.mmPatchChannel cId patch s)
1051        (\_ _ -> Nothing)
1052
1053-- | This renames the current channel's url name. It makes a request
1054-- to the server to change the name, but does not actually change the
1055-- name in Matterhorn yet; that is handled by a websocket event handled
1056-- asynchronously.
1057renameChannelUrl :: Text -> MH ()
1058renameChannelUrl name = do
1059    tId <- use csCurrentTeamId
1060    cId <- use (csCurrentChannelId tId)
1061    s <- getSession
1062    let patch = defaultChannelPatch { channelPatchName = Just name }
1063    doAsyncWith Normal $ do
1064        _ <- MM.mmPatchChannel cId patch s
1065        return Nothing
1066
1067getCurrentChannelTopic :: MH Text
1068getCurrentChannelTopic = do
1069    ch <- use csCurrentChannel
1070    return $ ch^.ccInfo.cdHeader
1071
1072beginCurrentChannelDeleteConfirm :: MH ()
1073beginCurrentChannelDeleteConfirm = do
1074    tId <- use csCurrentTeamId
1075    cId <- use (csCurrentChannelId tId)
1076    withChannel cId $ \chan -> do
1077        let chType = chan^.ccInfo.cdType
1078        if chType /= Direct
1079            then setMode DeleteChannelConfirm
1080            else mhError $ GenericError "Direct message channels cannot be deleted."
1081
1082updateChannelNotifyProps :: ChannelId -> ChannelNotifyProps -> MH ()
1083updateChannelNotifyProps cId notifyProps = do
1084    withChannel cId $ \chan -> do
1085        case chan^.ccInfo.cdTeamId of
1086            Nothing -> do
1087                ts <- use csTeams
1088                forM_ (HM.keys ts) (mh . invalidateCacheEntry . ChannelSidebar)
1089            Just tId -> mh $ invalidateCacheEntry $ ChannelSidebar tId
1090
1091        csChannel(cId).ccInfo.cdNotifyProps .= notifyProps
1092
1093toggleChannelFavoriteStatus :: MH ()
1094toggleChannelFavoriteStatus = do
1095    myId <- gets myUserId
1096    tId  <- use csCurrentTeamId
1097    cId <- use (csCurrentChannelId tId)
1098    userPrefs <- use (csResources.crUserPreferences)
1099    session <- getSession
1100    let favPref = favoriteChannelPreference userPrefs cId
1101        trueVal = "true"
1102        prefVal =  case favPref of
1103            Just True -> ""
1104            Just False -> trueVal
1105            Nothing -> trueVal
1106        pref = Preference
1107            { preferenceUserId = myId
1108            , preferenceCategory = PreferenceCategoryFavoriteChannel
1109            , preferenceName = PreferenceName $ idString cId
1110            , preferenceValue = PreferenceValue prefVal
1111            }
1112    doAsyncWith Normal $ do
1113        MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session
1114        return Nothing
1115