content: module Matterhorn.Events.Websocket
    ( handleWebsocketEvent
    , handleWebsocketActionResponse
    )
  where
  
  import           Prelude ()
  import           Matterhorn.Prelude
  
  import qualified Data.HashMap.Strict as HM
  import qualified Data.Sequence as Seq
  import qualified Data.Set as Set
  import qualified Data.Text as T
  
  import           Network.Mattermost.Lenses
  import           Network.Mattermost.Types
  import           Network.Mattermost.WebSocket
  
  import           Matterhorn.State.ChannelList
  import           Matterhorn.State.Channels
  import           Matterhorn.State.Common
  import           Matterhorn.State.Flagging
  import           Matterhorn.State.Messages
  import           Matterhorn.State.Reactions
  import           Matterhorn.State.Teams
  import           Matterhorn.State.Users
  import           Matterhorn.Types
  import           Matterhorn.Types.Common
  
  
  foreachTeam :: (TeamId -> MH ()) -> MH ()
  foreachTeam act = do
      ts <- use csTeams
      let myTIds = HM.keys ts
      mapM_ act myTIds
  
  handleWebsocketEvent :: WebsocketEvent -> MH ()
  handleWebsocketEvent we = do
      myId <- gets myUserId
      ts <- use csTeams
      let memberOf tId = HM.member tId ts
  
          -- The team ID is one of the teams we're in, or the team ID is
          -- absent, which typically indicates a DM channel event since DM
          -- channels are not associated with teams.
          inMyTeamOrDM (Just i) = memberOf i
          inMyTeamOrDM Nothing = True
  
          -- The team ID is one of the teams we're in. A missing team ID
          -- yields False.
          inMyTeam (Just i) = memberOf i
          inMyTeam Nothing = False
  
      case weEvent we of
          WMPosted
              | Just p <- wepPost (weData we) ->
                  when (inMyTeamOrDM (wepTeamId (weData we))) $ do
                      let wasMentioned = maybe False (Set.member myId) $ wepMentions (weData we)
                      addNewPostedMessage $ RecentPost p wasMentioned
                      mtId <- use csCurrentTeamId
                      cId <- case mtId of
                          Nothing -> return Nothing
                          Just tId -> use (csCurrentChannelId tId)
                      when (Just (postChannelId p) /= cId) $
                          showChannelInSidebar (p^.postChannelIdL) False
              | otherwise -> return ()
  
          WMPostEdited
              | Just p <- wepPost (weData we) -> do
                  editMessage p
  
                  currTid <- use csCurrentTeamId
                  foreachTeam $ \tId -> do
                      cId <- use (csCurrentChannelId tId)
                      when (Just (postChannelId p) == cId && Just tId == currTid) $
                          updateViewed False
                      when (Just (postChannelId p) /= cId) $
                          showChannelInSidebar (p^.postChannelIdL) False
              | otherwise -> return ()
  
          WMPostDeleted
              | Just p <- wepPost (weData we) -> do
                  deleteMessage p
  
                  currTid <- use csCurrentTeamId
                  foreachTeam $ \tId -> do
                      cId <- use (csCurrentChannelId tId)
                      when (Just (postChannelId p) == cId && Just tId == currTid) $
                          updateViewed False
                      when (Just (postChannelId p) /= cId) $
                          showChannelInSidebar (p^.postChannelIdL) False
              | otherwise -> return ()
  
          WMStatusChange
              | Just status <- wepStatus (weData we)
              , Just uId <- wepUserId (weData we) ->
                  setUserStatus uId status
              | otherwise -> return ()
  
          -- Despite this event's name, it means "a user was added to a
          -- channel". The event that occurs when a new user is added to
          -- the server, see WMNewUser.
          WMUserAdded
              | Just cId <- webChannelId (weBroadcast we) ->
                  when (wepUserId (weData we) == Just myId &&
                        inMyTeam (wepTeamId (weData we))) $
                      handleChannelInvite cId
              | otherwise -> return ()
  
          WMNewUser
              | Just uId <- wepUserId $ weData we ->
                  handleNewUsers (Seq.singleton uId) (return ())
              | otherwise -> return ()
  
          WMUserRemoved
              | Just cId <- wepChannelId (weData we) ->
                  when (webUserId (weBroadcast we) == Just myId) $
                      removeChannelFromState cId
              | otherwise -> return ()
  
          WMTyping
              | Just uId <- wepUserId $ weData we
              , Just cId <- webChannelId (weBroadcast we) -> handleTypingUser uId cId (wepParentId $ weData we)
              | otherwise -> return ()
  
          WMChannelDeleted
              | Just cId <- wepChannelId (weData we) ->
                  when (inMyTeamOrDM (webTeamId (weBroadcast we))) $
                      removeChannelFromState cId
              | otherwise -> return ()
  
          WMDirectAdded
              | Just cId <- webChannelId (weBroadcast we) -> handleChannelInvite cId
              | otherwise -> return ()
  
          -- An 'ephemeral message' is just Mattermost's version of our
          -- 'client message'. This can be a little bit wacky, e.g.
          -- if the user types '/shortcuts' in the browser, we'll get
          -- an ephemeral message even in MatterHorn with the browser
          -- shortcuts, but it's probably a good idea to handle these
          -- messages anyway.
          WMEphemeralMessage
              | Just p <- wepPost $ weData we -> postInfoMessage (sanitizeUserText $ p^.postMessageL)
              | otherwise -> return ()
  
          WMPreferenceChanged
              | Just prefs <- wepPreferences (weData we) ->
                  mapM_ applyPreferenceChange prefs
              | otherwise -> return ()
  
          WMPreferenceDeleted
              | Just pref <- wepPreferences (weData we)
              , Just fps <- mapM preferenceToFlaggedPost pref ->
                forM_ fps $ \f ->
                    updateMessageFlag (flaggedPostId f) False
              | otherwise -> return ()
  
          WMReactionAdded
              | Just r <- wepReaction (weData we)
              , Just cId <- webChannelId (weBroadcast we) -> addReactions cId [r]
              | otherwise -> return ()
  
          WMReactionRemoved
              | Just r <- wepReaction (weData we)
              , Just cId <- webChannelId (weBroadcast we) -> removeReaction r cId
              | otherwise -> return ()
  
          WMChannelViewed
              | Just cId <- wepChannelId $ weData we -> mhLog LogGeneral "WMChannelViewed received" >> refreshChannelById cId
              | otherwise -> return ()
  
          WMMultipleChannelsViewed ->
              case wepChannelTimes $ weData we of
                  Nothing -> return ()
                  Just m ->
                      forM_ (HM.keys m) refreshChannelById
  
          WMChannelUpdated
              | Just cId <- webChannelId $ weBroadcast we -> do
                  mChan <- preuse (csChannel(cId))
                  case mChan of
                      Just chan -> do
                          refreshChannelById cId
                          updateSidebar (chan^.ccInfo.cdTeamId)
                      Nothing -> return ()
              | otherwise -> return ()
  
          WMGroupAdded
              | Just cId <- webChannelId (weBroadcast we) -> handleChannelInvite cId
              | otherwise -> return ()
  
          WMChannelMemberUpdated
              | Just channelMember <- wepChannelMember $ weData we ->
                    when (channelMemberUserId channelMember == myId) $
                        updateChannelNotifyProps
                        (channelMemberChannelId channelMember)
                        (channelMemberNotifyProps channelMember)
              | otherwise -> return ()
  
          WMAddedToTeam
              | Just tId <- wepTeamId $ weData we
              , Just uId <- wepUserId $ weData we -> do
                  when (uId == myId && not (memberOf tId)) $ do
                      handleJoinTeam tId
              | otherwise -> return ()
  
          WMUpdateTeam
              | Just tId <- webTeamId $ weBroadcast we -> do
                  when (memberOf tId) $ do
                      handleUpdateTeam tId
              | otherwise -> return ()
  
          WMLeaveTeam
              | Just tId <- wepTeamId $ weData we
              , Just uId <- wepUserId $ weData we -> do
                  when (uId == myId && memberOf tId) $ do
                      handleLeaveTeam tId
              | otherwise -> return ()
  
          WMTeamDeleted -> do
              mhLog LogGeneral $ T.pack $
                  "WMTeamDeleted event: " <> show we
  
          WMUserUpdated
              | Just user <- wepUser (weData we) -> do
                  handleUserUpdated user
                  withCurrentTeam $ \tId ->
                      withCurrentChannel tId $ \cId _ -> do
                          refreshChannelById cId
              | otherwise -> return ()
  
          -- We deliberately ignore these events:
          WMChannelCreated -> return ()
          WMEmojiAdded -> return ()
          WMWebRTC -> return ()
          WMHello -> return ()
          WMAuthenticationChallenge -> return ()
          WMUserRoleUpdated -> return ()
          WMPluginStatusesChanged -> return ()
          WMPluginEnabled -> return ()
          WMPluginDisabled -> return ()
          WMUnknownEvent {} ->
              mhLog LogWebsocket $ T.pack $
                  "Websocket event not handled due to unknown event type: " <> show we
  
  handleWebsocketActionResponse :: WebsocketActionResponse -> MH ()
  handleWebsocketActionResponse r =
      case warStatus r of
          WebsocketActionStatusOK -> return ()
  