1module Matterhorn.State.UserListOverlay
2  ( enterChannelMembersUserList
3  , enterChannelInviteUserList
4  , enterDMSearchUserList
5
6  , userListSelectDown
7  , userListSelectUp
8  , userListPageDown
9  , userListPageUp
10  )
11where
12
13import           Prelude ()
14import           Matterhorn.Prelude
15
16import qualified Brick.Widgets.List as L
17import qualified Data.HashMap.Strict as HM
18import qualified Data.Sequence as Seq
19import qualified Data.Text as T
20import qualified Data.Vector as Vec
21import           Lens.Micro.Platform ( (.~), (.=) )
22
23import qualified Network.Mattermost.Endpoints as MM
24import qualified Network.Mattermost.Types.Config as MM
25import           Network.Mattermost.Types
26
27import           Matterhorn.State.Async ( doAsyncWith, AsyncPriority(Preempt) )
28import           Matterhorn.State.Channels ( createOrFocusDMChannel, addUserToCurrentChannel )
29import           Matterhorn.State.ListOverlay
30import           Matterhorn.Types
31
32
33-- | Show the user list overlay for searching/showing members of the
34-- current channel.
35enterChannelMembersUserList :: MH ()
36enterChannelMembersUserList = do
37    myTId <- use csCurrentTeamId
38    cId <- use (csCurrentChannelId myTId)
39    myId <- gets myUserId
40    session <- getSession
41
42    doAsyncWith Preempt $ do
43        stats <- MM.mmGetChannelStatistics cId session
44        return $ Just $ do
45            enterUserListMode myTId (ChannelMembers cId myTId) (Just $ channelStatsMemberCount stats)
46              (\u -> case u^.uiId /= myId of
47                True -> createOrFocusDMChannel u Nothing >> return True
48                False -> return False
49              )
50
51-- | Show the user list overlay for showing users that are not members
52-- of the current channel for the purpose of adding them to the
53-- channel.
54enterChannelInviteUserList :: MH ()
55enterChannelInviteUserList = do
56    myTId <- use csCurrentTeamId
57    cId <- use (csCurrentChannelId myTId)
58    myId <- gets myUserId
59    enterUserListMode myTId (ChannelNonMembers cId myTId) Nothing
60      (\u -> case u^.uiId /= myId of
61        True -> addUserToCurrentChannel u >> return True
62        False -> return False
63      )
64
65-- | Show the user list overlay for showing all users for the purpose of
66-- starting a direct message channel with another user.
67enterDMSearchUserList :: MH ()
68enterDMSearchUserList = do
69    myId <- gets myUserId
70    myTId <- use csCurrentTeamId
71    config <- use csClientConfig
72    let restrictTeam = case MM.clientConfigRestrictDirectMessage <$> config of
73            Just MM.RestrictTeam -> Just myTId
74            _ -> Nothing
75    enterUserListMode myTId (AllUsers restrictTeam) Nothing
76      (\u -> case u^.uiId /= myId of
77        True -> createOrFocusDMChannel u Nothing >> return True
78        False -> return False
79      )
80
81-- | Show the user list overlay with the given search scope, and issue a
82-- request to gather the first search results.
83enterUserListMode :: TeamId -> UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH ()
84enterUserListMode tId scope resultCount enterHandler = do
85    csTeam(tId).tsUserListOverlay.listOverlayRecordCount .= resultCount
86    enterListOverlayMode (csTeam(tId).tsUserListOverlay) UserListOverlay scope enterHandler getUserSearchResults
87
88userInfoFromPair :: User -> Text -> UserInfo
89userInfoFromPair u status =
90    userInfoFromUser u True & uiStatus .~ statusFromText status
91
92-- | Move the selection up in the user list overlay by one user.
93userListSelectUp :: MH ()
94userListSelectUp = userListMove L.listMoveUp
95
96-- | Move the selection down in the user list overlay by one user.
97userListSelectDown :: MH ()
98userListSelectDown = userListMove L.listMoveDown
99
100-- | Move the selection up in the user list overlay by a page of users
101-- (userListPageSize).
102userListPageUp :: MH ()
103userListPageUp = userListMove (L.listMoveBy (-1 * userListPageSize))
104
105-- | Move the selection down in the user list overlay by a page of users
106-- (userListPageSize).
107userListPageDown :: MH ()
108userListPageDown = userListMove (L.listMoveBy userListPageSize)
109
110-- | Transform the user list results in some way, e.g. by moving the
111-- cursor, and then check to see whether the modification warrants a
112-- prefetch of more search results.
113userListMove :: (L.List Name UserInfo -> L.List Name UserInfo) -> MH ()
114userListMove = listOverlayMove (csCurrentTeam.tsUserListOverlay)
115
116-- | The number of users in a "page" for cursor movement purposes.
117userListPageSize :: Int
118userListPageSize = 10
119
120getUserSearchResults :: UserSearchScope
121                     -- ^ The scope to search
122                     -> Session
123                     -- ^ The connection session
124                     -> Text
125                     -- ^ The search string
126                     -> IO (Vec.Vector UserInfo)
127getUserSearchResults scope s searchString = do
128    -- Unfortunately, we don't get pagination control when there is a
129    -- search string in effect. We'll get at most 100 results from a
130    -- search.
131    let query = UserSearch { userSearchTerm = if T.null searchString then " " else searchString
132                           -- Hack alert: Searching with the string " "
133                           -- above is a hack to use the search
134                           -- endpoint to get "all users" instead of
135                           -- those matching a particular non-empty
136                           -- non-whitespace string. This is because
137                           -- only the search endpoint provides a
138                           -- control to eliminate deleted users from
139                           -- the results. If we don't do this, and
140                           -- use the /users endpoint instead, we'll
141                           -- get deleted users in those results and
142                           -- then those deleted users will disappear
143                           -- from the results once the user enters a
144                           -- non-empty string string.
145                           , userSearchAllowInactive = False
146                           , userSearchWithoutTeam = False
147                           , userSearchInChannelId = case scope of
148                               ChannelMembers cId _ -> Just cId
149                               _                    -> Nothing
150                           , userSearchNotInTeamId = Nothing
151                           , userSearchNotInChannelId = case scope of
152                               ChannelNonMembers cId _ -> Just cId
153                               _                       -> Nothing
154                           , userSearchTeamId = case scope of
155                               AllUsers tId            -> tId
156                               ChannelMembers _ tId    -> Just tId
157                               ChannelNonMembers _ tId -> Just tId
158                           }
159    users <- MM.mmSearchUsers query s
160
161    let uList = toList users
162        uIds = userId <$> uList
163
164    -- Now fetch status info for the users we got.
165    case null uList of
166        False -> do
167            statuses <- MM.mmGetUserStatusByIds (Seq.fromList uIds) s
168            let statusMap = HM.fromList [ (statusUserId e, statusStatus e) | e <- toList statuses ]
169                usersWithStatus = [ userInfoFromPair u (fromMaybe "" $ HM.lookup (userId u) statusMap)
170                                  | u <- uList
171                                  ]
172
173            return $ Vec.fromList usersWithStatus
174        True -> return mempty
175