packages feed

matterhorn-40901.0.0: src/State/Users.hs

module State.Users
  (
    handleNewUsers
  , handleTypingUser
  , handleNewUserDirect
  )
where

import           Prelude ()
import           Prelude.MH

import           Data.Time ( getCurrentTime )
import           Lens.Micro.Platform

import qualified Network.Mattermost.Endpoints as MM
import           Network.Mattermost.Types

import           Config
import           Types

import           State.Common


handleNewUsers :: Seq UserId -> MH ()
handleNewUsers newUserIds = doAsyncMM Preempt getUserInfo addNewUsers
    where getUserInfo session _ =
              do nUsers  <- MM.mmGetUsersByIds newUserIds session
                 let usrInfo u = userInfoFromUser u True
                     usrList = toList nUsers
                 return $ usrInfo <$> usrList

          addNewUsers :: [UserInfo] -> MH ()
          addNewUsers = mapM_ addNewUser

-- | Handle the typing events from the websocket to show the currently
-- typing users on UI
handleTypingUser :: UserId -> ChannelId -> MH ()
handleTypingUser uId cId = do
  config <- use (csResources.crConfiguration)
  when (configShowTypingIndicator config) $ do
    ts <- liftIO getCurrentTime -- get time now
    csChannels %= modifyChannelById cId (addChannelTypingUser uId ts)

handleNewUserDirect :: User -> MH ()
handleNewUserDirect newUser = do
    let usrInfo = userInfoFromUser newUser True
    addNewUser usrInfo