content: {-# LANGUAGE MultiWayIf #-}
  
  module Matterhorn.State.Messages
    ( PostToAdd(..)
    , lastMsg
    , sendMessage
    , editMessage
    , deleteMessage
    , addNewPostedMessage
    , addObtainedMessages
    , asyncFetchMoreMessages
    , asyncFetchMessagesForGap
    , asyncFetchMessagesSurrounding
    , fetchVisibleIfNeeded
    , disconnectChannels
    , toggleMessageTimestamps
    , toggleVerbatimBlockTruncation
    , jumpToPost
    , addMessageToState
    )
  where
  
  import           Prelude ()
  import           Matterhorn.Prelude
  
  import           Brick.Main ( getVtyHandle, invalidateCache )
  import qualified Brick.Widgets.FileBrowser as FB
  import           Control.Exception ( SomeException, try )
  import qualified Data.Aeson as A
  import qualified Data.ByteString.Lazy as BSL
  import qualified Data.Foldable as F
  import qualified Data.HashMap.Strict as HM
  import qualified Data.Set as Set
  import qualified Data.Sequence as Seq
  import qualified Data.Text as T
  import           Graphics.Vty ( outputIface )
  import           Graphics.Vty.Output ( ringTerminalBell )
  import           Lens.Micro.Platform ( Traversal', (.=), (%=), (%~), (.~)
                                       , to, at, traversed, filtered, ix, _1, _Just )
  
  import           Network.Mattermost
  import qualified Network.Mattermost.Endpoints as MM
  import           Network.Mattermost.Lenses
  import           Network.Mattermost.Types
  
  import           Matterhorn.Constants
  import           Matterhorn.State.Channels
  import           Matterhorn.State.ChannelList ( updateSidebar )
  import           Matterhorn.State.Common
  import           Matterhorn.State.ThreadWindow
  import           Matterhorn.State.MessageSelect
  import           Matterhorn.State.Users
  import           Matterhorn.TimeUtils
  import           Matterhorn.Types
  import           Matterhorn.Types.Common ( sanitizeUserText )
  import           Matterhorn.Types.DirectionalSeq ( DirectionalSeq, SeqDirection )
  
  
  -- ----------------------------------------------------------------------
  -- Message gaps
  
  
  -- | Called to add an UnknownGap to the end of the Messages collection
  -- for all channels when the client has become disconnected from the
  -- server.  This gaps will later be removed by successful fetching
  -- overlaps if the connection is re-established.  Note that the
  -- disconnect is re-iterated periodically via a re-connect timer
  -- attempt, so do not duplicate gaps.  Also clear any flags
  -- representing a pending exchange with the server (which will now
  -- never complete).
  addDisconnectGaps :: MH ()
  addDisconnectGaps = mapM_ onEach . filteredChannelIds (const True) =<< use csChannels
      where onEach c = do addEndGap c
                          clearPendingFlags c
                          invalidateChannelRenderingCache c
  
  -- | Websocket was disconnected, so all channels may now miss some
  -- messages
  disconnectChannels :: MH ()
  disconnectChannels = addDisconnectGaps
  
  toggleMessageTimestamps :: MH ()
  toggleMessageTimestamps = do
      mh invalidateCache
      let toggle c = c { configShowMessageTimestamps = not (configShowMessageTimestamps c)
                       }
      csResources.crConfiguration %= toggle
  
  defaultVerbatimTruncateHeight :: Int
  defaultVerbatimTruncateHeight = 25
  
  toggleVerbatimBlockTruncation :: MH ()
  toggleVerbatimBlockTruncation = do
      mh invalidateCache
      st <- use id
      -- Restore the configured setting, or a default if the configuration
      -- does not specify a setting.
      let toggle Nothing = (st^.csResources.crConfiguration.configTruncateVerbatimBlocksL) <|>
                           Just defaultVerbatimTruncateHeight
          toggle (Just _) = Nothing
      csVerbatimTruncateSetting %= toggle
  
  clearPendingFlags :: ChannelId -> MH ()
  clearPendingFlags c = csChannel(c).ccInfo.cdFetchPending .= False
  
  addEndGap :: ChannelId -> MH ()
  addEndGap cId = withChannel cId $ \chan ->
      let lastmsg_ = chan^.ccMessageInterface.miMessages.to reverseMessages.to lastMsg
          lastIsGap = maybe False isGap lastmsg_
          gapMsg = newGapMessage timeJustAfterLast
          timeJustAfterLast = maybe t0 (justAfter . _mDate) lastmsg_
          t0 = ServerTime $ originTime  -- use any time for a channel with no messages yet
          newGapMessage = newMessageOfType
                          (T.pack "Disconnected. Will refresh when connected.")
                          (C UnknownGapAfter)
      in unless lastIsGap
             (csChannels %= modifyChannelById cId (ccMessageInterface.miMessages %~ addMessage gapMsg))
  
  lastMsg :: RetrogradeMessages -> Maybe Message
  lastMsg = withFirstMessage id
  
  -- | Send a message and attachments to the specified channel.
  sendMessage :: ChannelId -> EditMode -> Text -> [AttachmentData] -> MH ()
  sendMessage chanId mode rawMsg attachments = do
      let msg = T.strip rawMsg
      when (not $ shouldSkipMessage msg attachments) $ do
          status <- use csConnectionStatus
          case status of
              Disconnected -> do
                  let m = T.concat [ "Cannot send messages while disconnected. Enable logging to "
                                   , "get disconnection information. If Matterhorn's reconnection "
                                   , "attempts are failing, use `/reconnect` to attempt to "
                                   , "reconnect manually."
                                   ]
                  mhError $ GenericError m
              Connected -> do
                  session <- getSession
                  doAsync Preempt $ do
                      -- Upload attachments
                      fileInfos <- forM attachments $ \a -> do
                          MM.mmUploadFile chanId (FB.fileInfoFilename $ attachmentDataFileInfo a)
                              (attachmentDataBytes a) session
  
                      let fileIds = Seq.fromList $
                                    fmap fileInfoId $
                                    concat $
                                    (F.toList . MM.uploadResponseFileInfos) <$> fileInfos
  
                      case mode of
                          NewPost -> do
                              let pendingPost = (rawPost msg chanId) { rawPostFileIds = fileIds }
                              void $ MM.mmCreatePost pendingPost session
                          Replying _ p -> do
                              let pendingPost = (rawPost msg chanId) { rawPostRootId = postRootId p <|> (Just $ postId p)
                                                                     , rawPostFileIds = fileIds
                                                                     }
                              void $ MM.mmCreatePost pendingPost session
                          Editing p ty -> do
                              let body = case ty of
                                           CP Emote -> addEmoteFormatting msg
                                           _ -> msg
                                  update = (postUpdateBody body) { postUpdateFileIds = if null fileIds
                                                                                       then Nothing
                                                                                       else Just fileIds
                                                                 }
                              void $ MM.mmPatchPost (postId p) update session
  
  shouldSkipMessage :: Text -> [AttachmentData] -> Bool
  shouldSkipMessage "" [] = True
  shouldSkipMessage s [] = T.all (`elem` (" \t"::String)) s
  shouldSkipMessage _ _ = False
  
  editMessage :: Post -> MH ()
  editMessage new = do
      myId <- gets myUserId
      withChannel (new^.postChannelIdL) $ \chan -> do
          let mTId = chan^.ccInfo.cdTeamId
          mBaseUrl <- case mTId of
              Nothing -> return Nothing
              Just tId -> Just <$> getServerBaseUrl tId
  
          hostname <- use (csResources.crConn.cdHostnameL)
  
          let (msg, mentionedUsers) = clientPostToMessage (toClientPost hostname mBaseUrl new (new^.postRootIdL))
              isEditedMessage m = m^.mMessageId == Just (MessagePostId $ new^.postIdL)
  
          csChannel (new^.postChannelIdL) . ccMessageInterface.miMessages . traversed . filtered isEditedMessage .= msg
  
          invalidateChannelRenderingCache $ new^.postChannelIdL
          invalidateMessageRenderingCacheByPostId $ postId new
  
          editPostInOpenThread mTId new msg
  
          fetchMentionedUsers mentionedUsers
  
          when (postUserId new /= Just myId) $
              csChannel (new^.postChannelIdL) %= adjustEditedThreshold new
  
          csPostMap.ix(postId new) .= msg
  
  deleteMessage :: Post -> MH ()
  deleteMessage new = do
      let isDeletedMessage m = m^.mMessageId == Just (MessagePostId $ new^.postIdL) ||
                               isReplyTo (new^.postIdL) m
          chan :: Traversal' ChatState ClientChannel
          chan = csChannel (new^.postChannelIdL)
      chan.ccMessageInterface.miMessages.traversed.filtered isDeletedMessage %= (& mDeleted .~ True)
      chan %= adjustUpdated new
  
      withChannel (new^.postChannelIdL) $ \ch -> do
          case ch^.ccInfo.cdTeamId of
              Nothing -> return ()
              Just tId -> deletePostFromOpenThread tId new
  
      invalidateChannelRenderingCache $ new^.postChannelIdL
      invalidateMessageRenderingCacheByPostId $ postId new
  
  deletePostFromOpenThread :: TeamId -> Post -> MH ()
  deletePostFromOpenThread tId p = do
      let isDeletedMessage m = m^.mMessageId == Just (MessagePostId $ p^.postIdL) ||
                               isReplyTo (p^.postIdL) m
  
      -- If the post being deleted is in the thread, we just need to
      -- remove it from the thread view. But if this effectively empties
      -- the thread, that's because this was the root. In that case we
      -- need to close down the window.
      threadInterfaceDeleteWhere tId (p^.postChannelIdL) isDeletedMessage
  
      ti <- use (csTeam(tId).tsThreadInterface)
      when (isJust ti) $ do
          isEmpty <- threadInterfaceEmpty tId
          when isEmpty $ do
              closeThreadWindow tId
              postInfoMessage "The thread you were viewing was deleted."
  
  addNewPostedMessage :: PostToAdd -> MH ()
  addNewPostedMessage p =
      addMessageToState True True p >>= postProcessMessageAdd
  
  -- | Adds the set of Posts to the indicated channel. The Posts must all
  -- be for the specified Channel. The reqCnt argument indicates how many
  -- posts were requested, which will determine whether a gap message is
  -- added to either end of the posts list or not.
  --
  -- The addTrailingGap is only True when fetching the very latest
  -- messages for the channel, and will suppress the generation of a Gap
  -- message following the added block of messages.
  addObtainedMessages :: ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
  addObtainedMessages cId reqCnt addTrailingGap posts = do
    invalidateChannelRenderingCache cId
    if null $ posts^.postsOrderL
    then do when addTrailingGap $
              -- Fetched at the end of the channel, but nothing was
              -- available.  This is common if this is a new channel
              -- with no messages in it.  Need to remove any gaps that
              -- exist at the end of the channel.
              csChannels %= modifyChannelById cId
                (ccMessageInterface.miMessages %~
                 \msgs -> let startPoint = join $ _mMessageId <$> getLatestPostMsg msgs
                          in fst $ removeMatchesFromSubset isGap startPoint Nothing msgs)
            return NoAction
    else
      -- Adding a block of server-provided messages, which are known to
      -- be contiguous.  Locally this may overlap with some UnknownGap
      -- messages, which can therefore be removed.  Alternatively the
      -- new block may be discontiguous with the local blocks, in which
      -- case the new block should be surrounded by UnknownGaps.
      withChannelOrDefault cId NoAction $ \chan -> do
          let pIdList = toList (posts^.postsOrderL)
              mTId = chan^.ccInfo.cdTeamId
              -- the first and list PostId in the batch to be added
              earliestPId = last pIdList
              latestPId = head pIdList
              earliestDate = postCreateAt $ (posts^.postsPostsL) HM.! earliestPId
              latestDate = postCreateAt $ (posts^.postsPostsL) HM.! latestPId
  
              localMessages = chan^.ccMessageInterface.miMessages
  
              -- Get a list of the duplicated message PostIds between
              -- the messages already in the channel and the new posts
              -- to be added.
  
              match = snd $ removeMatchesFromSubset
                            (\m -> maybe False (\p -> p `elem` pIdList) (messagePostId m))
                            (Just (MessagePostId earliestPId))
                            (Just (MessagePostId latestPId))
                            localMessages
  
              accum m l =
                  case messagePostId m of
                      Just pId -> pId : l
                      Nothing -> l
              dupPIds = foldr accum [] match
  
              -- If there were any matches, then there was overlap of
              -- the new messages with existing messages.
  
              -- Don't re-add matching messages (avoid overhead like
              -- re-checking/re-fetching related post information, and
              -- do not signal action needed for notifications), and
              -- remove any gaps in the overlapping region.
  
              newGapMessage d isOlder =
                -- newGapMessage is a helper for generating a gap
                -- message
                do uuid <- generateUUID
                   let txt = "Load " <>
                             (if isOlder then "older" else "newer") <>
                             " messages" <>
                             (if isOlder then "  ↥↥↥" else "  ↧↧↧")
                       ty = if isOlder
                            then C UnknownGapBefore
                            else C UnknownGapAfter
                   return (newMessageOfType txt ty d
                           & mMessageId .~ Just (MessageUUID uuid))
  
              -- If this batch contains the latest known messages, do
              -- not add a following gap.  A gap at this point is added
              -- by a websocket disconnect, and any fetches thereafter
              -- are assumed to be the most current information (until
              -- another disconnect), so no gap is needed.
              -- Additionally, the presence of a gap at the end for a
              -- connected client causes a fetch of messages at this
              -- location, so adding the gap here would cause an
              -- infinite update loop.
  
              addingAtEnd = maybe True (latestDate >=) $
                            (^.mDate) <$> getLatestPostMsg localMessages
  
              addingAtStart = maybe True (earliestDate <=) $
                              (^.mDate) <$> getEarliestPostMsg localMessages
              removeStart = if addingAtStart && noMoreBefore
                            then Nothing
                            else Just (MessagePostId earliestPId)
              removeEnd = if addTrailingGap || (addingAtEnd && noMoreAfter)
                          then Nothing
                          else Just (MessagePostId latestPId)
  
              noMoreBefore = reqCnt < 0 && length pIdList < (-reqCnt)
              noMoreAfter = addTrailingGap || reqCnt > 0 && length pIdList < reqCnt
  
              reAddGapBefore = earliestPId `elem` dupPIds || noMoreBefore
              -- addingAtEnd used to be in reAddGapAfter but does not
              -- seem to be needed.  I may have missed a specific use
              -- case/scenario, so I've left it commented out here for
              -- debug assistance.
              reAddGapAfter = latestPId `elem` dupPIds || {- addingAtEnd || -} noMoreAfter
  
          -- The post map returned by the server will *already* have
          -- all thread messages for each post that is part of a
          -- thread. By calling installMessagesFromPosts here, we go ahead
          -- and populate the csPostMap with those posts so that below, in
          -- addMessageToState, we notice that we already know about reply
          -- parent messages and can avoid fetching them. This converts
          -- the posts to Messages and stores those and also returns
          -- them, but we don't need them here. We just want the post
          -- map update. This also gathers up the set of all mentioned
          -- usernames in the text of the messages which we need to use to
          -- submit a single batch request for user metadata so we don't
          -- submit one request per mention.
          void $ installMessagesFromPosts mTId posts
  
          -- Add all the new *unique* posts into the existing channel
          -- corpus, generating needed fetches of data associated with
          -- the post, and determining an notification action to be
          -- taken (if any).
          action <- foldr andProcessWith NoAction <$>
            mapM (addMessageToState False False . OldPost)
                     [ (posts^.postsPostsL) HM.! p
                     | p <- toList (posts^.postsOrderL)
                     , not (p `elem` dupPIds)
                     ]
  
          -- The channel messages now include all the fetched messages.
          -- Things to do at this point are:
          --
          --   1. Remove any duplicates just added, as well as any gaps
          --   2. Add new gaps (if needed) at either end of the added
          --      messages.
          --   3. Update the "current selection" if it was on a removed message.
          --
          -- Do this with the updated copy of the channel's messages.
  
          withChannelOrDefault cId () $ \updchan -> do
            let updMsgs = updchan ^. ccMessageInterface.miMessages
  
            -- Remove any gaps in the added region.  If there was an
            -- active message selection and it is one of the removed
            -- gaps, reset the selection to the beginning or end of the
            -- added region (if there are any added selectable messages,
            -- otherwise just the end if the message list in it's
            -- entirety, or no selection at all).
  
            let (resultMessages, removedMessages) =
                  removeMatchesFromSubset isGap removeStart removeEnd updMsgs
            csChannels %= modifyChannelById cId
              (ccMessageInterface.miMessages .~ resultMessages)
  
            let processTeam tId = do
                  -- Determine if the current selected message was one of the
                  -- removed messages.
                  selMsgId <- use (channelMessageSelect(cId).to selectMessageId)
                  let rmvdSel = do
                        i <- selMsgId -- :: Maybe MessageId
                        findMessage i removedMessages
                      rmvdSelType = _mType <$> rmvdSel
  
                  case rmvdSel of
                    Nothing -> return ()
                    Just rm ->
                      if isGap rm
                      then return ()  -- handled during gap insertion below
                      else do
                        -- Replaced a selected message that wasn't a gap.
                        -- This is unlikely, but may occur if the previously
                        -- selected message was just deleted by another user
                        -- and is in the fetched region.  The choices here are
                        -- to move the selection, or cancel the selection.
                        -- Both will be unpleasant surprises for the user, but
                        -- cancelling the selection is probably the better
                        -- choice than allowing the user to perform select
                        -- actions on a message that isn't the one they just
                        -- selected.
                        popMode tId
                        channelMessageSelect(cId) .= MessageSelectState Nothing
  
                  -- Add a gap at each end of the newly fetched data, unless:
                  --   1. there is an overlap
                  --   2. there is no more in the indicated direction
                  --      a. indicated by adding messages later than any currently
                  --         held messages (see note above re 'addingAtEnd').
                  --      b. the amount returned was less than the amount requested
  
                  if reAddGapBefore
                    then
                      -- No more gaps.  If the selected gap was removed, move
                      -- select to first (earliest) message)
                      case rmvdSelType of
                        Just (C UnknownGapBefore) ->
                          channelMessageSelect(cId) .= MessageSelectState (pure $ MessagePostId earliestPId)
                        _ -> return ()
                    else do
                      -- add a gap at the start of the newly fetched block and
                      -- make that the active selection if this fetch removed
                      -- the previously selected gap in this direction.
                      gapMsg <- newGapMessage (justBefore earliestDate) True
                      csChannels %= modifyChannelById cId
                        (ccMessageInterface.miMessages %~ addMessage gapMsg)
                      -- Move selection from old gap to new gap
                      case rmvdSelType of
                        Just (C UnknownGapBefore) -> do
                          channelMessageSelect(cId) .= MessageSelectState (gapMsg^.mMessageId)
                        _ -> return ()
  
                  if reAddGapAfter
                    then
                      -- No more gaps.  If the selected gap was removed, move
                      -- select to last (latest) message.
                      case rmvdSelType of
                        Just (C UnknownGapAfter) ->
                          channelMessageSelect(cId) .= MessageSelectState (pure $ MessagePostId latestPId)
                        _ -> return ()
                    else do
                      -- add a gap at the end of the newly fetched block and
                      -- make that the active selection if this fetch removed
                      -- the previously selected gap in this direction.
                      gapMsg <- newGapMessage (justAfter latestDate) False
                      csChannels %= modifyChannelById cId
                        (ccMessageInterface.miMessages %~ addMessage gapMsg)
                      -- Move selection from old gap to new gap
                      case rmvdSelType of
                        Just (C UnknownGapAfter) ->
                          channelMessageSelect(cId) .= MessageSelectState (gapMsg^.mMessageId)
                        _ -> return ()
  
            case mTId of
                Nothing -> do
                    ts <- use csTeams
                    forM_ (HM.keys ts) processTeam
                Just tId -> processTeam tId
  
          -- Now initiate fetches for use information for any
          -- as-yet-unknown users related to this new set of messages
  
          let users = foldr (\post s -> maybe s (flip Set.insert s) (postUserId post))
                            Set.empty (posts^.postsPostsL)
              addUnknownUsers inputUserIds = do
                  knownUserIds <- Set.fromList <$> gets allUserIds
                  let unknownUsers = Set.difference inputUserIds knownUserIds
                  if Set.null unknownUsers
                     then return ()
                     else handleNewUsers (Seq.fromList $ toList unknownUsers) (return ())
  
          addUnknownUsers users
  
          -- Return the aggregated user notification action needed
          -- relative to the set of added messages.
  
          return action
  
  -- | Adds a possibly new message to the associated channel contents.
  -- Returns an indicator of whether the user should be potentially
  -- notified of a change (a new message not posted by this user, a
  -- mention of the user, etc.).  This operation has no effect on any
  -- existing UnknownGap entries and should be called when those are
  -- irrelevant.
  --
  -- The first boolean argument ('doFetchMentionedUsers') indicates
  -- whether this function should schedule a fetch for any mentioned
  -- users in the message. This is provided so that callers can batch
  -- this operation if a large collection of messages is being added
  -- together, in which case we don't want this function to schedule a
  -- single request per message (worst case). If you're calling this as
  -- part of scrollback processing, you should pass False. Otherwise if
  -- you're adding only a single message, you should pass True.
  --
  -- The second boolean argument ('fetchAuthor') is similar to the first
  -- boolean argument but it refers to the author of the message instead
  -- of any user mentions within the message body.
  --
  -- The third argument ('newPostData') indicates whether this message
  -- is being added as part of a fetch of old messages (e.g. scrollback)
  -- or if ti is a new message and affects things like whether
  -- notifications are generated and if the "New Messages" marker gets
  -- updated.
  addMessageToState :: Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
  addMessageToState doFetchMentionedUsers fetchAuthor newPostData = do
      let (new, wasMentioned) = case newPostData of
            -- A post from scrollback history has no mention data, and
            -- that's okay: we only need to track mentions to tell the
            -- user that recent posts contained mentions.
            OldPost p      -> (p, False)
            RecentPost p m -> (p, m)
  
      hostname <- use (csResources.crConn.cdHostnameL)
  
      st <- use id
      case st ^? csChannel(postChannelId new) of
          Nothing -> do
              session <- getSession
              doAsyncWith Preempt $ do
                  nc <- MM.mmGetChannel (postChannelId new) session
                  member <- MM.mmGetChannelMember (postChannelId new) UserMe session
  
                  let chType = nc^.channelTypeL
                      pref = showGroupChannelPref (postChannelId new) (myUserId st)
  
                  -- If the channel has been archived, we don't want to
                  -- post this message or add the channel to the state.
                  case channelDeleted nc of
                      True -> return Nothing
                      False -> return $ Just $ Work "addMessageToState[1]" $ do
                          -- If the incoming message is for a group
                          -- channel we don't know about, that's because
                          -- it was previously hidden by the user. We need
                          -- to show it, and to do that we need to update
                          -- the server-side preference. (That, in turn,
                          -- triggers a channel refresh.)
                          if chType == Group
                              then applyPreferenceChange pref
                              else refreshChannel SidebarUpdateImmediate nc member
  
                          addMessageToState doFetchMentionedUsers fetchAuthor newPostData >>=
                              postProcessMessageAdd
  
              return NoAction
          Just ch -> do
              let mTId = ch^.ccInfo.cdTeamId
              mBaseUrl <- case mTId of
                  Nothing -> return Nothing
                  Just tId -> Just <$> getServerBaseUrl tId
  
              let cp = toClientPost hostname mBaseUrl new (new^.postRootIdL)
                  fromMe = (cp^.cpUser == (Just $ myUserId st)) &&
                           (isNothing $ cp^.cpUserOverride)
                  userPrefs = st^.csResources.crUserPreferences
                  isJoinOrLeave = case cp^.cpType of
                    Join  -> True
                    Leave -> True
                    _     -> False
                  ignoredJoinLeaveMessage =
                    not (userPrefs^.userPrefShowJoinLeave) && isJoinOrLeave
                  cId = postChannelId new
  
                  -- TODO: match server-side logic to determine whether
                  -- this message counts as a post, for post-counting
                  -- purposes, to decide whether this should trigger an
                  -- increment of the total/viewed post counts
                  maybeIncrementTotalMessageCount =
                      let shouldIncrement = case newPostData of
                                                RecentPost {} ->
                                                    True
                                                _ ->
                                                    False
                      in if shouldIncrement
                         then incrementTotalMessageCount
                         else id
  
                  maybeIncrementViewedMessageCount currCId =
                      let shouldIncrement = case newPostData of
                                                RecentPost {} ->
                                                    currCId == Just cId
                                                _ ->
                                                    False
                      in if shouldIncrement
                         then incrementViewedMessageCount
                         else id
  
                  maybeIncrementMessageCounts currCId =
                      maybeIncrementTotalMessageCount .
                      maybeIncrementViewedMessageCount currCId
  
                  doAddMessage = do
                      -- Do we have the user data for the post author?
                      case cp^.cpUser of
                          Nothing -> return ()
                          Just authorId -> when fetchAuthor $ do
                              authorResult <- gets (userById authorId)
                              when (isNothing authorResult) $
                                  handleNewUsers (Seq.singleton authorId) (return ())
  
                      mcurTId <- use csCurrentTeamId
                      currCId <- case mcurTId of
                          Nothing -> return Nothing
                          Just curTId -> use (csCurrentChannelId curTId)
  
                      flags <- use (csResources.crFlaggedPosts)
                      let (msg', mentionedUsers) = clientPostToMessage cp
                                   & _1.mFlagged .~ ((cp^.cpPostId) `Set.member` flags)
  
                      when doFetchMentionedUsers $
                          fetchMentionedUsers mentionedUsers
  
                      csPostMap.at(postId new) .= Just msg'
                      invalidateChannelRenderingCache cId
                      invalidateMessageRenderingCacheByPostId $ postId new
                      csChannels %= modifyChannelById cId
                        ((ccMessageInterface.miMessages %~ addMessage msg') .
                         (if not ignoredJoinLeaveMessage then adjustUpdated new else id) .
                         maybeIncrementMessageCounts currCId .
                         (\c -> if currCId == Just cId
                                then c
                                else case newPostData of
                                       OldPost _ -> c
                                       RecentPost _ _ ->
                                         updateNewMessageIndicator new c) .
                         (\c -> if wasMentioned
                                then c & ccInfo.cdMentionCount %~ succ
                                else c)
                        )
  
                      -- Check for whether the post is part of a thread
                      -- being viewed. If so, add the post to that thread
                      -- window as well.
                      --
                      -- Note that the team ID we pass here is either the
                      -- team ID with which the channel is associated
                      -- (mTId) or, if that is Nothing in the case of a DM
                      -- channel, the currently-selected team (mcurTId)
                      -- since all DM channels appear in all teams.
                      addPostToOpenThread (mTId <|> mcurTId) new msg'
  
                      updateSidebar mTId
  
                      postedChanMessage
  
                  doHandleAddedMessage = do
                      -- If the message is in reply to another message,
                      -- try to find it in the scrollback for the post's
                      -- channel. If the message isn't there, fetch it. If
                      -- we have to fetch it, don't post this message to the
                      -- channel until we have fetched the parent.
                      case cp^.cpInReplyToPost of
                          Just parentId ->
                              case getMessageForPostId st parentId of
                                  Nothing -> do
                                      doAsyncChannelMM Preempt cId
                                          (\s _ -> MM.mmGetThread parentId s)
                                          (\_ p -> Just $ Work "addMessageToState[2]" $ updatePostMap mTId p)
                                  _ -> return ()
                          _ -> return ()
  
                      doAddMessage
  
                  postedChanMessage =
                    withChannelOrDefault (postChannelId new) NoAction $ \chan -> do
                        mcurrTid <- use csCurrentTeamId
                        case mcurrTid of
                            Nothing -> return NoAction
                            Just currTid -> do
                                currCId <- use (csCurrentChannelId currTid)
  
                                let notifyPref = notifyPreference (myUser st) chan
                                    curChannelAction = if Just (postChannelId new) == currCId
                                                       then UpdateServerViewed
                                                       else NoAction
                                    originUserAction =
                                      if | fromMe                            -> NoAction
                                         | ignoredJoinLeaveMessage           -> NoAction
                                         | notifyPref == NotifyOptionAll     -> NotifyUser [newPostData]
                                         | notifyPref == NotifyOptionMention
                                             && wasMentioned                 -> NotifyUser [newPostData]
                                         | otherwise                         -> NoAction
  
                                return $ curChannelAction `andProcessWith` originUserAction
  
              doHandleAddedMessage
  
  addPostToOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
  addPostToOpenThread Nothing _ _ = return ()
  addPostToOpenThread (Just tId) new msg =
      case postRootId new of
          Nothing -> return ()
          Just parentId -> do
              mRoot <- preuse (maybeThreadInterface(tId)._Just.miRootPostId)
              when (mRoot == Just parentId) $
                  modifyThreadMessages tId (new^.postChannelIdL) (addMessage msg)
  
  editPostInOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
  editPostInOpenThread Nothing _ _ = return ()
  editPostInOpenThread (Just tId) new msg =
       case postRootId new of
          Nothing -> return ()
          Just parentId -> do
              mRoot <- preuse (maybeThreadInterface(tId)._Just.miRootPostId)
              when (mRoot == Just parentId) $ do
                  mhLog LogGeneral "editPostInOpenThread: updating message"
                  let isEditedMessage m = m^.mMessageId == Just (MessagePostId $ new^.postIdL)
                  modifyEachThreadMessage tId (new^.postChannelIdL)
                      (\m -> if isEditedMessage m then msg else m)
  
  -- | PostProcessMessageAdd is an internal value that informs the main
  -- code whether the user should be notified (e.g., ring the bell) or
  -- the server should be updated (e.g., that the channel has been
  -- viewed).  This is a monoid so that it can be folded over when there
  -- are multiple inbound posts to be processed.
  data PostProcessMessageAdd = NoAction
                             | NotifyUser [PostToAdd]
                             | UpdateServerViewed
                             | NotifyUserAndServer [PostToAdd]
  
  andProcessWith
    :: PostProcessMessageAdd -> PostProcessMessageAdd -> PostProcessMessageAdd
  andProcessWith NoAction x                                        = x
  andProcessWith x NoAction                                        = x
  andProcessWith (NotifyUserAndServer p) UpdateServerViewed        = NotifyUserAndServer p
  andProcessWith (NotifyUserAndServer p1) (NotifyUser p2)          = NotifyUserAndServer (p1 <> p2)
  andProcessWith (NotifyUserAndServer p1) (NotifyUserAndServer p2) = NotifyUserAndServer (p1 <> p2)
  andProcessWith (NotifyUser p1) (NotifyUserAndServer p2)          = NotifyUser (p1 <> p2)
  andProcessWith (NotifyUser p1) (NotifyUser p2)                   = NotifyUser (p1 <> p2)
  andProcessWith (NotifyUser p) UpdateServerViewed                 = NotifyUserAndServer p
  andProcessWith UpdateServerViewed UpdateServerViewed             = UpdateServerViewed
  andProcessWith UpdateServerViewed (NotifyUserAndServer p)        = NotifyUserAndServer p
  andProcessWith UpdateServerViewed (NotifyUser p)                 = NotifyUserAndServer p
  
  -- | postProcessMessageAdd performs the actual actions indicated by
  -- the corresponding input value.
  postProcessMessageAdd :: PostProcessMessageAdd -> MH ()
  postProcessMessageAdd ppma = postOp ppma
      where
          postOp NoAction                = return ()
          postOp UpdateServerViewed      = updateViewed False
          postOp (NotifyUser p)          = maybeRingBell >> mapM_ maybeNotify p
          postOp (NotifyUserAndServer p) = updateViewed False >> maybeRingBell >> mapM_ maybeNotify p
  
  maybeNotify :: PostToAdd -> MH ()
  maybeNotify (OldPost _) = do
      return ()
  maybeNotify (RecentPost post mentioned) = runNotifyCommand post mentioned
  
  maybeRingBell :: MH ()
  maybeRingBell = do
      doBell <- use (csResources.crConfiguration.configActivityBellL)
      when doBell $ do
          vty <- mh getVtyHandle
          liftIO $ ringTerminalBell $ outputIface vty
  
  -- | When we add posts to the application state, we either get them
  -- from the server during scrollback fetches (here called 'OldPost') or
  -- we get them from websocket events when they are posted in real time
  -- (here called 'RecentPost').
  data PostToAdd =
      OldPost Post
      -- ^ A post from the server's history
      | RecentPost Post Bool
      -- ^ A message posted to the channel since the user connected, along
      -- with a flag indicating whether the post triggered any of the
      -- user's mentions. We need an extra flag because the server
      -- determines whether the post has any mentions, and that data is
      -- only available in websocket events (and then provided to this
      -- constructor).
  
  -- Notification Version 2 payload definition
  data NotificationV2 = NotificationV2
      { version :: Int
      , message :: Text
      , mention :: Bool
      , from :: Text
      } deriving (Show)
  
  instance A.ToJSON NotificationV2 where
      toJSON (NotificationV2 vers msg mentioned sender) =
          A.object [ "version"  A..= vers
                   , "message"  A..= msg
                   , "mention"  A..= mentioned
                   , "from"     A..= sender
                   ]
  
  -- Notification Version 3 payload definition
  data NotificationV3 = NotificationV3
      { notifyV3Version :: Int
      , notifyV3Message :: Text
      , notifyV3Mention :: Bool
      , notifyV3From :: Text
      , notifyV3MessageType :: Text
      } deriving (Show)
  
  instance A.ToJSON NotificationV3 where
      toJSON (NotificationV3 vers msg mentioned sender msgTy) =
          A.object [ "version"     A..= vers
                   , "message"     A..= msg
                   , "mention"     A..= mentioned
                   , "from"        A..= sender
                   , "messageType" A..= msgTy
                   ]
  
  -- We define a notifyGetPayload for each notification version.
  notifyGetPayload :: NotificationVersion -> ChatState -> Post -> Bool -> Maybe BSL.ByteString
  notifyGetPayload NotifyV1 _ _ _ = do return mempty
  notifyGetPayload NotifyV2 st post mentioned = do
      let notification = NotificationV2 2 msg mentioned sender
      return (A.encode notification)
          where
              msg = sanitizeUserText $ postMessage post
              sender = maybePostUsername st post
  notifyGetPayload NotifyV3 st post mentioned = do
      let notification = NotificationV3 3 msg mentioned sender msgTy
      return (A.encode notification)
          where
              msg = sanitizeUserText $ postMessage post
              sender = maybePostUsername st post
              msgTy = case postType post of
                  PostTypeJoinChannel       -> "joinChannel"
                  PostTypeLeaveChannel      -> "leaveChannel"
                  PostTypeAddToChannel      -> "addToChannel"
                  PostTypeRemoveFromChannel -> "removeFromChannel"
                  PostTypeHeaderChange      -> "headerChange"
                  PostTypeDisplayNameChange -> "displayNameChange"
                  PostTypePurposeChange     -> "purposeChange"
                  PostTypeChannelDeleted    -> "channelDeleted"
                  PostTypeEphemeral         -> "ephemeral"
                  PostTypeUnknown _         -> "unknown"
  
  handleNotifyCommand :: Post -> Bool -> NotificationVersion -> MH ()
  handleNotifyCommand post mentioned NotifyV1 = do
      outputChan <- use (csResources.crSubprocessLog)
      st <- use id
      notifyCommand <- use (csResources.crConfiguration.configActivityNotifyCommandL)
      case notifyCommand of
          Nothing -> return ()
          Just cmd ->
              doAsyncWith Preempt $ do
                  let messageString = T.unpack $ sanitizeUserText $ postMessage post
                      notified = if mentioned then "1" else "2"
                      sender = T.unpack $ maybePostUsername st post
                  runLoggedCommand outputChan (T.unpack cmd)
                                   [notified, sender, messageString] Nothing Nothing
                  return Nothing
  handleNotifyCommand post mentioned NotifyV2 = do
      outputChan <- use (csResources.crSubprocessLog)
      st <- use id
      let payload = notifyGetPayload NotifyV2 st post mentioned
      notifyCommand <- use (csResources.crConfiguration.configActivityNotifyCommandL)
      case notifyCommand of
          Nothing -> return ()
          Just cmd ->
              doAsyncWith Preempt $ do
                  runLoggedCommand outputChan (T.unpack cmd) [] payload Nothing
                  return Nothing
  handleNotifyCommand post mentioned NotifyV3 = do
      outputChan <- use (csResources.crSubprocessLog)
      st <- use id
      let payload = notifyGetPayload NotifyV3 st post mentioned
      notifyCommand <- use (csResources.crConfiguration.configActivityNotifyCommandL)
      case notifyCommand of
          Nothing -> return ()
          Just cmd ->
              doAsyncWith Preempt $ do
                  runLoggedCommand outputChan (T.unpack cmd) [] payload Nothing
                  return Nothing
  
  runNotifyCommand :: Post -> Bool -> MH ()
  runNotifyCommand post mentioned = do
      notifyVersion <- use (csResources.crConfiguration.configActivityNotifyVersionL)
      handleNotifyCommand post mentioned notifyVersion
  
  maybePostUsername :: ChatState -> Post -> T.Text
  maybePostUsername st p =
      fromMaybe T.empty $ do
          uId <- postUserId p
          usernameForUserId uId st
  
  -- | Fetches additional message history for the current channel.  This
  -- is generally called when in ChannelScroll mode, in which state the
  -- output is cached and seen via a scrolling viewport; new messages
  -- received in this mode are not normally shown, but this explicit
  -- user-driven fetch should be displayed, so this also invalidates the
  -- cache.
  --
  -- This function assumes it is being called to add "older" messages to
  -- the message history (i.e. near the beginning of the known
  -- messages).  It will normally try to overlap the fetch with the
  -- known existing messages so that when the fetch results are
  -- processed (which should be a contiguous set of messages as provided
  -- by the server) there will be an overlap with existing messages; if
  -- there is no overlap, then a special "gap" must be inserted in the
  -- area between the existing messages and the newly fetched messages
  -- to indicate that this client does not know if there are missing
  -- messages there or not.
  --
  -- In order to achieve an overlap, this code attempts to get the
  -- second oldest messages as the message ID to pass to the server as
  -- the "older than" marker ('postQueryBefore'), so that the oldest
  -- message here overlaps with the fetched results to ensure no gap
  -- needs to be inserted.  However, there may already be a gap between
  -- the oldest and second-oldest messages, so this code must actually
  -- search for the first set of two *contiguous* messages it is aware
  -- of to avoid adding additional gaps. (It's OK if gaps are added, but
  -- the user must explicitly request a check for messages in order to
  -- eliminate them, so it's better to avoid adding them in the first
  -- place).  This code is nearly always used to extend the older
  -- history of a channel that information has already been retrieved
  -- from, so it's almost certain that there are at least two contiguous
  -- messages to use as a starting point, but exceptions are new
  -- channels and empty channels.
  asyncFetchMoreMessages :: MH ()
  asyncFetchMoreMessages =
      withCurrentTeam $ \tId ->
          withCurrentChannel tId $ \cId chan -> do
              let offset = max 0 $ length (chan^.ccMessageInterface.miMessages) - 2
                  page = offset `div` messageFetchPageSize
                  usefulMsgs = getTwoContiguousPosts Nothing (chan^.ccMessageInterface.miMessages.to reverseMessages)
                  sndOldestId = (messagePostId . snd) =<< usefulMsgs
                  query = MM.defaultPostQuery
                            { MM.postQueryPage = maybe (Just page) (const Nothing) sndOldestId
                            , MM.postQueryPerPage = Just messageFetchPageSize
                            , MM.postQueryBefore = sndOldestId
                            }
                  addTrailingGap = MM.postQueryBefore query == Nothing &&
                                   MM.postQueryPage query == Just 0
              doAsyncChannelMM Preempt cId
                  (\s c -> MM.mmGetPostsForChannel c query s)
                  (\c p -> Just $ Work "asyncFetchMoreMessages" $ do
                      pp <- addObtainedMessages c (-messageFetchPageSize) addTrailingGap p
                      postProcessMessageAdd pp)
  
  -- | Given a starting point and a direction to move from that point,
  -- returns the closest two adjacent messages on that direction (as a
  -- tuple of closest and next-closest), or Nothing if there are no
  -- adjacent messages in the indicated direction.
  getTwoContiguousPosts :: SeqDirection dir =>
                           Maybe Message
                        -> DirectionalSeq dir Message
                        -> Maybe (Message, Message)
  getTwoContiguousPosts startMsg msgs =
    let go start =
          do anchor <- getRelMessageId (_mMessageId =<< start) msgs
             hinge <- getRelMessageId (anchor^.mMessageId) msgs
             if isGap anchor || isGap hinge
               then go $ Just anchor
               else Just (anchor, hinge)
    in go startMsg
  
  
  asyncFetchMessagesForGap :: ChannelId -> Message -> MH ()
  asyncFetchMessagesForGap cId gapMessage =
    when (isGap gapMessage) $
    withChannel cId $ \chan ->
      let offset = max 0 $ length (chan^.ccMessageInterface.miMessages) - 2
          page = offset `div` messageFetchPageSize
          chanMsgs = chan^.ccMessageInterface.miMessages
          fromMsg = Just gapMessage
          fetchNewer = case gapMessage^.mType of
                         C UnknownGapAfter -> True
                         C UnknownGapBefore -> False
                         _ -> error "fetch gap messages: unknown gap message type"
          baseId = messagePostId . snd =<<
                   case gapMessage^.mType of
                      C UnknownGapAfter -> getTwoContiguousPosts fromMsg $
                                           reverseMessages chanMsgs
                      C UnknownGapBefore -> getTwoContiguousPosts fromMsg chanMsgs
                      _ -> error "fetch gap messages: unknown gap message type"
          query = MM.defaultPostQuery
                  { MM.postQueryPage = maybe (Just page) (const Nothing) baseId
                  , MM.postQueryPerPage = Just messageFetchPageSize
                  , MM.postQueryBefore = if fetchNewer then Nothing else baseId
                  , MM.postQueryAfter = if fetchNewer then baseId else Nothing
                  }
          addTrailingGap = MM.postQueryBefore query == Nothing &&
                           MM.postQueryPage query == Just 0
      in doAsyncChannelMM Preempt cId
         (\s c -> MM.mmGetPostsForChannel c query s)
         (\c p -> Just $ Work "asyncFetchMessagesForGap" $ do
             void $ addObtainedMessages c (-messageFetchPageSize) addTrailingGap p)
  
  -- | Given a particular message ID, this fetches n messages before and
  -- after immediately before and after the specified message in order
  -- to establish some context for that message.  This is frequently
  -- used as a background operation when looking at search or flag
  -- results so that jumping to message select mode for one of those
  -- messages will show a bit of context (and it also prevents showing
  -- gap messages for adjacent targets).
  --
  -- The result will be adding at most 2n messages to the channel, with
  -- the input post ID being somewhere in the middle of the added
  -- messages.
  --
  -- Note that this fetch will add messages to the channel, but it
  -- performs no notifications or updates of new-unread indicators
  -- because it is assumed to be used for non-current (previously-seen)
  -- messages in background mode.
  asyncFetchMessagesSurrounding :: ChannelId -> PostId -> MH ()
  asyncFetchMessagesSurrounding cId pId = do
      let query = MM.defaultPostQuery
            { MM.postQueryBefore = Just pId
            , MM.postQueryPerPage = Just reqAmt
            }
          reqAmt = 5  -- both before and after
      doAsyncChannelMM Preempt cId
        -- first get some messages before the target, no overlap
        (\s c -> MM.mmGetPostsForChannel c query s)
        (\c p -> Just $ Work "asyncFetchMessagesSurrounding[1]" $ do
            let last2ndId = secondToLastPostId p
            void $ addObtainedMessages c (-reqAmt) False p
            -- now start 2nd from end of this fetch to fetch some
            -- messages forward, also overlapping with this fetch and
            -- the original message ID to eliminate all gaps in this
            -- surrounding set of messages.
            let query' = MM.defaultPostQuery
                         { MM.postQueryAfter = last2ndId
                         , MM.postQueryPerPage = Just $ reqAmt + 2
                         }
            doAsyncChannelMM Preempt cId
              (\s' c' -> MM.mmGetPostsForChannel c' query' s')
              (\c' p' -> Just $ Work "asyncFetchMessagesSurrounding[2]" $ do
                  void $ addObtainedMessages c' (reqAmt + 2) False p'
              )
        )
        where secondToLastPostId posts =
                let pl = toList $ postsOrder posts
                in if length pl > 1 then Just $ last $ init pl else Nothing
  
  fetchVisibleIfNeeded :: TeamId -> MH ()
  fetchVisibleIfNeeded tId = do
      sts <- use csConnectionStatus
      when (sts == Connected) $ do
          withCurrentChannel tId $ \cId chan -> do
              let msgs = chan^.ccMessageInterface.miMessages.to reverseMessages
                  (numRemaining, gapInDisplayable, _, rel'pId, overlap) =
                      foldl gapTrail (numScrollbackPosts, False, Nothing, Nothing, 2) msgs
  
                  gapTrail :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
                           -> Message
                           -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
                  gapTrail a@(_,  True, _, _, _) _ = a
                  gapTrail a@(0,     _, _, _, _) _ = a
                  gapTrail   (a, False, b, c, d) m | isGap m = (a, True, b, c, d)
                  gapTrail (remCnt, _, prev'pId, prev''pId, ovl) msg =
                      (remCnt - 1, False, msg^.mMessageId <|> prev'pId, prev'pId <|> prev''pId,
                       ovl + if not (isPostMessage msg) then 1 else 0)
  
                  numToRequest = numRemaining + overlap
                  query = MM.defaultPostQuery
                          { MM.postQueryPage    = Just 0
                          , MM.postQueryPerPage = Just numToRequest
                          }
                  finalQuery = case rel'pId of
                                 Just (MessagePostId pid) -> query { MM.postQueryBefore = Just pid }
                                 _ -> query
                  op = \s c -> MM.mmGetPostsForChannel c finalQuery s
                  addTrailingGap = MM.postQueryBefore finalQuery == Nothing &&
                                   MM.postQueryPage finalQuery == Just 0
              when ((not $ chan^.ccInfo.cdFetchPending) && gapInDisplayable) $ do
                     csChannel(cId).ccInfo.cdFetchPending .= True
                     doAsyncChannelMM Preempt cId op
                         (\c p -> Just $ Work "fetchVisibleIfNeeded" $ do
                             csChannel(c).ccInfo.cdFetchPending .= False
                             addObtainedMessages c (-numToRequest) addTrailingGap p >>= postProcessMessageAdd)
  
  -- | Given a post ID, switch to that post's channel and select the post
  -- in message selection mode.
  --
  -- This function will do what it can to honor the request even when we
  -- don't know about the post because it hasn't been fetched, or when
  -- the post is in a channel that we aren't a member of. In each case a
  -- reasonable effort will be made (fetch the post, join the channel)
  -- before giving up.
  jumpToPost :: PostId -> MH ()
  jumpToPost pId = withCurrentTeam $ \tId -> do
      st <- use id
      case getMessageForPostId st pId of
        Just msg ->
          case msg ^. mChannelId of
            Just cId -> do
                -- Are we a member of the channel?
                case findChannelById cId (st^.csChannels) of
                    Nothing ->
                        joinChannel' tId cId (Just $ jumpToPost pId)
                    Just _ -> do
                        setFocus tId cId
                        beginMessageSelect (csChannelMessageInterface(cId))
                        channelMessageSelect(cId) .= MessageSelectState (msg^.mMessageId)
            Nothing ->
              error "INTERNAL: selected Post ID not associated with a channel"
        Nothing -> do
            session <- getSession
            doAsyncWith Preempt $ do
                result <- try $ MM.mmGetPost pId session
                return $ Just $ Work "jumpToPost" $ do
                    case result of
                        Right p -> do
                            -- Are we a member of the channel?
                            case findChannelById (postChannelId p) (st^.csChannels) of
                                -- If not, join it and then try jumping to
                                -- the post if the channel join is successful.
                                Nothing -> do
                                    joinChannel' tId (postChannelId p) (Just $ jumpToPost pId)
                                -- Otherwise add the post to the state and
                                -- then jump.
                                Just _ -> do
                                    void $ addMessageToState True True (OldPost p)
                                    jumpToPost pId
                        Left (_::SomeException) ->
                            postErrorMessage' "Could not fetch linked post"
  