{-# 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.Interface ( 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.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 :: MH ()
addDisconnectGaps = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ChannelId -> MH ()
onEach forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientChannel -> Bool) -> ClientChannels -> [ChannelId]
filteredChannelIds (forall a b. a -> b -> a
const Bool
True) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ClientChannels
csChannels
    where onEach :: ChannelId -> MH ()
onEach ChannelId
c = do ChannelId -> MH ()
addEndGap ChannelId
c
                        ChannelId -> MH ()
clearPendingFlags ChannelId
c
                        ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
c

-- | Websocket was disconnected, so all channels may now miss some
-- messages
disconnectChannels :: MH ()
disconnectChannels :: MH ()
disconnectChannels = MH ()
addDisconnectGaps

toggleMessageTimestamps :: MH ()
toggleMessageTimestamps :: MH ()
toggleMessageTimestamps = do
    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
    let toggle :: Config -> Config
toggle Config
c = Config
c { configShowMessageTimestamps :: Bool
configShowMessageTimestamps = Bool -> Bool
not (Config -> Bool
configShowMessageTimestamps Config
c)
                     }
    Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Config -> Config
toggle

defaultVerbatimTruncateHeight :: Int
defaultVerbatimTruncateHeight :: Int
defaultVerbatimTruncateHeight = Int
25

toggleVerbatimBlockTruncation :: MH ()
toggleVerbatimBlockTruncation :: MH ()
toggleVerbatimBlockTruncation = do
    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    -- Restore the configured setting, or a default if the configuration
    -- does not specify a setting.
    let toggle :: Maybe a -> Maybe Int
toggle Maybe a
Nothing = (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Int)
configTruncateVerbatimBlocksL) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                         forall a. a -> Maybe a
Just Int
defaultVerbatimTruncateHeight
        toggle (Just a
_) = forall a. Maybe a
Nothing
    Lens' ChatState (Maybe Int)
csVerbatimTruncateSetting forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. Maybe a -> Maybe Int
toggle

clearPendingFlags :: ChannelId -> MH ()
clearPendingFlags :: ChannelId -> MH ()
clearPendingFlags ChannelId
c = ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
c)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Bool
cdFetchPending forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

addEndGap :: ChannelId -> MH ()
addEndGap :: ChannelId -> MH ()
addEndGap ChannelId
cId = ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
    let lastmsg_ :: Maybe Message
lastmsg_ = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to RetrogradeMessages -> Maybe Message
lastMsg
        lastIsGap :: Bool
lastIsGap = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Message -> Bool
isGap Maybe Message
lastmsg_
        gapMsg :: Message
gapMsg = ServerTime -> Message
newGapMessage ServerTime
timeJustAfterLast
        timeJustAfterLast :: ServerTime
timeJustAfterLast = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ServerTime
t0 (ServerTime -> ServerTime
justAfter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> ServerTime
_mDate) Maybe Message
lastmsg_
        t0 :: ServerTime
t0 = UTCTime -> ServerTime
ServerTime forall a b. (a -> b) -> a -> b
$ UTCTime
originTime  -- use any time for a channel with no messages yet
        newGapMessage :: ServerTime -> Message
newGapMessage = Text -> MessageType -> ServerTime -> Message
newMessageOfType
                        (String -> Text
T.pack String
"Disconnected. Will refresh when connected.")
                        (ClientMessageType -> MessageType
C ClientMessageType
UnknownGapAfter)
    in forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
lastIsGap
           (Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId (Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg))

lastMsg :: RetrogradeMessages -> Maybe Message
lastMsg :: RetrogradeMessages -> Maybe Message
lastMsg = forall dir r.
SeqDirection dir =>
(Message -> r) -> DirectionalSeq dir Message -> Maybe r
withFirstMessage forall a. a -> a
id

-- | Send a message and attachments to the specified channel.
sendMessage :: ChannelId -> EditMode -> Text -> [AttachmentData] -> MH ()
sendMessage :: ChannelId -> EditMode -> Text -> [AttachmentData] -> MH ()
sendMessage ChannelId
chanId EditMode
mode Text
msg [AttachmentData]
attachments =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
shouldSkipMessage Text
msg) forall a b. (a -> b) -> a -> b
$ do
        ConnectionStatus
status <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ConnectionStatus
csConnectionStatus
        case ConnectionStatus
status of
            ConnectionStatus
Disconnected -> do
                let m :: Text
m = [Text] -> Text
T.concat [ Text
"Cannot send messages while disconnected. Enable logging to "
                                 , Text
"get disconnection information. If Matterhorn's reconnection "
                                 , Text
"attempts are failing, use `/reconnect` to attempt to "
                                 , Text
"reconnect manually."
                                 ]
                MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
m
            ConnectionStatus
Connected -> do
                Session
session <- MH Session
getSession
                AsyncPriority -> IO () -> MH ()
doAsync AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
                    -- Upload attachments
                    [UploadResponse]
fileInfos <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [AttachmentData]
attachments forall a b. (a -> b) -> a -> b
$ \AttachmentData
a -> do
                        ChannelId -> String -> ByteString -> Session -> IO UploadResponse
MM.mmUploadFile ChannelId
chanId (FileInfo -> String
FB.fileInfoFilename forall a b. (a -> b) -> a -> b
$ AttachmentData -> FileInfo
attachmentDataFileInfo AttachmentData
a)
                            (AttachmentData -> ByteString
attachmentDataBytes AttachmentData
a) Session
session

                    let fileIds :: Seq FileId
fileIds = forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$
                                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileInfo -> FileId
fileInfoId forall a b. (a -> b) -> a -> b
$
                                  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
                                  (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. UploadResponse -> Seq FileInfo
MM.uploadResponseFileInfos) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UploadResponse]
fileInfos

                    case EditMode
mode of
                        EditMode
NewPost -> do
                            let pendingPost :: RawPost
pendingPost = (Text -> ChannelId -> RawPost
rawPost Text
msg ChannelId
chanId) { rawPostFileIds :: Seq FileId
rawPostFileIds = Seq FileId
fileIds }
                            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ RawPost -> Session -> IO Post
MM.mmCreatePost RawPost
pendingPost Session
session
                        Replying Message
_ Post
p -> do
                            let pendingPost :: RawPost
pendingPost = (Text -> ChannelId -> RawPost
rawPost Text
msg ChannelId
chanId) { rawPostRootId :: Maybe PostId
rawPostRootId = Post -> Maybe PostId
postRootId Post
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
p)
                                                                   , rawPostFileIds :: Seq FileId
rawPostFileIds = Seq FileId
fileIds
                                                                   }
                            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ RawPost -> Session -> IO Post
MM.mmCreatePost RawPost
pendingPost Session
session
                        Editing Post
p MessageType
ty -> do
                            let body :: Text
body = case MessageType
ty of
                                         CP ClientPostType
Emote -> Text -> Text
addEmoteFormatting Text
msg
                                         MessageType
_ -> Text
msg
                                update :: PostUpdate
update = (Text -> PostUpdate
postUpdateBody Text
body) { postUpdateFileIds :: Maybe (Seq FileId)
postUpdateFileIds = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq FileId
fileIds
                                                                                     then forall a. Maybe a
Nothing
                                                                                     else forall a. a -> Maybe a
Just Seq FileId
fileIds
                                                               }
                            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ PostId -> PostUpdate -> Session -> IO Post
MM.mmPatchPost (Post -> PostId
postId Post
p) PostUpdate
update Session
session

shouldSkipMessage :: Text -> Bool
shouldSkipMessage :: Text -> Bool
shouldSkipMessage Text
"" = Bool
True
shouldSkipMessage Text
s = (Char -> Bool) -> Text -> Bool
T.all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t"::String)) Text
s

editMessage :: Post -> MH ()
editMessage :: Post -> MH ()
editMessage Post
new = do
    UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
        let mTId :: Maybe TeamId
mTId = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId
        Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
            Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Just TeamId
tId -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId

        Text
hostname <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources ConnectionData
crConnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ConnectionData Text
cdHostnameL)

        let (Message
msg, Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage (Text -> Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Text
hostname Maybe TeamBaseURL
mBaseUrl Post
new (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post (Maybe PostId)
postRootIdL))
            isEditedMessage :: Message -> Bool
isEditedMessage Message
m = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL)

        ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isEditedMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message
msg

        ChannelId -> MH ()
invalidateChannelRenderingCache forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL
        PostId -> MH ()
invalidateMessageRenderingCacheByPostId forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new

        Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread Maybe TeamId
mTId Post
new Message
msg

        Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentionedUsers

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Post -> Maybe UserId
postUserId Post
new forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just UserId
myId) forall a b. (a -> b) -> a -> b
$
            ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Post -> ClientChannel -> ClientChannel
adjustEditedThreshold Post
new

        Lens' ChatState (HashMap PostId Message)
csPostMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix(Post -> PostId
postId Post
new) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message
msg

deleteMessage :: Post -> MH ()
deleteMessage :: Post -> MH ()
deleteMessage Post
new = do
    let isDeletedMessage :: Message -> Bool
isDeletedMessage Message
m = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Bool -> Bool -> Bool
||
                             PostId -> Message -> Bool
isReplyTo (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Message
m
        chan :: Traversal' ChatState ClientChannel
        chan :: Traversal' ChatState ClientChannel
chan = ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL)
    Traversal' ChatState ClientChannel
chanforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversedforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isDeletedMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a b. a -> (a -> b) -> b
& Lens' Message Bool
mDeleted forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
    Traversal' ChatState ClientChannel
chan forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Post -> ClientChannel -> ClientChannel
adjustUpdated Post
new

    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) forall a b. (a -> b) -> a -> b
$ \ClientChannel
ch -> do
        case ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
            Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just TeamId
tId -> TeamId -> Post -> MH ()
deletePostFromOpenThread TeamId
tId Post
new

    ChannelId -> MH ()
invalidateChannelRenderingCache forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL
    PostId -> MH ()
invalidateMessageRenderingCacheByPostId forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new

deletePostFromOpenThread :: TeamId -> Post -> MH ()
deletePostFromOpenThread :: TeamId -> Post -> MH ()
deletePostFromOpenThread TeamId
tId Post
p = do
    let isDeletedMessage :: Message -> Bool
isDeletedMessage Message
m = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Bool -> Bool -> Bool
||
                             PostId -> Message -> Bool
isReplyTo (Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Message
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.
    TeamId -> ChannelId -> (Message -> Bool) -> MH ()
threadInterfaceDeleteWhere TeamId
tId (Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) Message -> Bool
isDeletedMessage

    Maybe ThreadInterface
ti <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe ThreadInterface
ti) forall a b. (a -> b) -> a -> b
$ do
        Bool
isEmpty <- TeamId -> MH Bool
threadInterfaceEmpty TeamId
tId
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEmpty forall a b. (a -> b) -> a -> b
$ do
            TeamId -> MH ()
closeThreadWindow TeamId
tId
            Text -> MH ()
postInfoMessage Text
"The thread you were viewing was deleted."

addNewPostedMessage :: PostToAdd -> MH ()
addNewPostedMessage :: PostToAdd -> MH ()
addNewPostedMessage PostToAdd
p =
    Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
True Bool
True PostToAdd
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PostProcessMessageAdd -> MH ()
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 :: ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
cId Int
reqCnt Bool
addTrailingGap Posts
posts = do
  ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (Seq PostId)
postsOrderL
  then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
addTrailingGap forall a b. (a -> b) -> a -> b
$
            -- 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.
            Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
              (Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
               \Messages
msgs -> let startPoint :: Maybe MessageId
startPoint = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ Message -> Maybe MessageId
_mMessageId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getLatestPostMsg Messages
msgs
                        in forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset Message -> Bool
isGap Maybe MessageId
startPoint forall a. Maybe a
Nothing Messages
msgs)
          forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
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.
    forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId PostProcessMessageAdd
NoAction forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
        let pIdList :: [PostId]
pIdList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (Seq PostId)
postsOrderL)
            mTId :: Maybe TeamId
mTId = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId
            -- the first and list PostId in the batch to be added
            earliestPId :: PostId
earliestPId = forall a. [a] -> a
last [PostId]
pIdList
            latestPId :: PostId
latestPId = forall a. [a] -> a
head [PostId]
pIdList
            earliestDate :: ServerTime
earliestDate = Post -> ServerTime
postCreateAt forall a b. (a -> b) -> a -> b
$ (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL) forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
earliestPId
            latestDate :: ServerTime
latestDate = Post -> ServerTime
postCreateAt forall a b. (a -> b) -> a -> b
$ (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL) forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
latestPId

            localMessages :: Messages
localMessages = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages

            -- Get a list of the duplicated message PostIds between
            -- the messages already in the channel and the new posts
            -- to be added.

            match :: Messages
match = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset
                          (\Message
m -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\PostId
p -> PostId
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
pIdList) (Message -> Maybe PostId
messagePostId Message
m))
                          (forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
earliestPId))
                          (forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
latestPId))
                          Messages
localMessages

            accum :: Message -> [PostId] -> [PostId]
accum Message
m [PostId]
l =
                case Message -> Maybe PostId
messagePostId Message
m of
                    Just PostId
pId -> PostId
pId forall a. a -> [a] -> [a]
: [PostId]
l
                    Maybe PostId
Nothing -> [PostId]
l
            dupPIds :: [PostId]
dupPIds = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Message -> [PostId] -> [PostId]
accum [] Messages
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 :: ServerTime -> Bool -> MH Message
newGapMessage ServerTime
d Bool
isOlder =
              -- newGapMessage is a helper for generating a gap
              -- message
              do UUID
uuid <- MH UUID
generateUUID
                 let txt :: Text
txt = Text
"Load " forall a. Semigroup a => a -> a -> a
<>
                           (if Bool
isOlder then Text
"older" else Text
"newer") forall a. Semigroup a => a -> a -> a
<>
                           Text
" messages" forall a. Semigroup a => a -> a -> a
<>
                           (if Bool
isOlder then Text
"  ↥↥↥" else Text
"  ↧↧↧")
                     ty :: MessageType
ty = if Bool
isOlder
                          then ClientMessageType -> MessageType
C ClientMessageType
UnknownGapBefore
                          else ClientMessageType -> MessageType
C ClientMessageType
UnknownGapAfter
                 forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MessageType -> ServerTime -> Message
newMessageOfType Text
txt MessageType
ty ServerTime
d
                         forall a b. a -> (a -> b) -> b
& Lens' Message (Maybe MessageId)
mMessageId forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just (UUID -> MessageId
MessageUUID UUID
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 :: Bool
addingAtEnd = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ServerTime
latestDate forall a. Ord a => a -> a -> Bool
>=) forall a b. (a -> b) -> a -> b
$
                          (forall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getLatestPostMsg Messages
localMessages

            addingAtStart :: Bool
addingAtStart = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ServerTime
earliestDate forall a. Ord a => a -> a -> Bool
<=) forall a b. (a -> b) -> a -> b
$
                            (forall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getEarliestPostMsg Messages
localMessages
            removeStart :: Maybe MessageId
removeStart = if Bool
addingAtStart Bool -> Bool -> Bool
&& Bool
noMoreBefore
                          then forall a. Maybe a
Nothing
                          else forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
earliestPId)
            removeEnd :: Maybe MessageId
removeEnd = if Bool
addTrailingGap Bool -> Bool -> Bool
|| (Bool
addingAtEnd Bool -> Bool -> Bool
&& Bool
noMoreAfter)
                        then forall a. Maybe a
Nothing
                        else forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
latestPId)

            noMoreBefore :: Bool
noMoreBefore = Int
reqCnt forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pIdList forall a. Ord a => a -> a -> Bool
< (-Int
reqCnt)
            noMoreAfter :: Bool
noMoreAfter = Bool
addTrailingGap Bool -> Bool -> Bool
|| Int
reqCnt forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pIdList forall a. Ord a => a -> a -> Bool
< Int
reqCnt

            reAddGapBefore :: Bool
reAddGapBefore = PostId
earliestPId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| Bool
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 :: Bool
reAddGapAfter = PostId
latestPId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| {- addingAtEnd || -} Bool
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.
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Maybe TeamId -> Posts -> MH Messages
installMessagesFromPosts Maybe TeamId
mTId Posts
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).
        PostProcessMessageAdd
action <- forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
andProcessWith PostProcessMessageAdd
NoAction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
False Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post -> PostToAdd
OldPost)
                   [ (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL) forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
p
                   | PostId
p <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (Seq PostId)
postsOrderL)
                   , Bool -> Bool
not (PostId
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
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.

        forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId () forall a b. (a -> b) -> a -> b
$ \ClientChannel
updchan -> do
          let updMsgs :: Messages
updMsgs = ClientChannel
updchan forall s a. s -> Getting a s a -> a
^. Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
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 (Messages
resultMessages, Messages
removedMessages) =
                (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset Message -> Bool
isGap Maybe MessageId
removeStart Maybe MessageId
removeEnd Messages
updMsgs
          Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
            (Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> b -> s -> t
.~ Messages
resultMessages)

          let processTeam :: TeamId -> MH ()
processTeam TeamId
tId = do
                -- Determine if the current selected message was one of the
                -- removed messages.
                Maybe MessageId
selMsgId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to MessageSelectState -> Maybe MessageId
selectMessageId)
                let rmvdSel :: Maybe Message
rmvdSel = do
                      MessageId
i <- Maybe MessageId
selMsgId -- :: Maybe MessageId
                      MessageId -> Messages -> Maybe Message
findMessage MessageId
i Messages
removedMessages
                    rmvdSelType :: Maybe MessageType
rmvdSelType = Message -> MessageType
_mType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Message
rmvdSel

                case Maybe Message
rmvdSel of
                  Maybe Message
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  Just Message
rm ->
                    if Message -> Bool
isGap Message
rm
                    then forall (m :: * -> *) a. Monad m => a -> m a
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.
                      TeamId -> MH ()
popMode TeamId
tId
                      ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState forall a. Maybe a
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 Bool
reAddGapBefore
                  then
                    -- No more gaps.  If the selected gap was removed, move
                    -- select to first (earliest) message)
                    case Maybe MessageType
rmvdSelType of
                      Just (C ClientMessageType
UnknownGapBefore) ->
                        ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
earliestPId)
                      Maybe MessageType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
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.
                    Message
gapMsg <- ServerTime -> Bool -> MH Message
newGapMessage (ServerTime -> ServerTime
justBefore ServerTime
earliestDate) Bool
True
                    Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
                      (Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg)
                    -- Move selection from old gap to new gap
                    case Maybe MessageType
rmvdSelType of
                      Just (C ClientMessageType
UnknownGapBefore) -> do
                        ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
gapMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
                      Maybe MessageType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

                if Bool
reAddGapAfter
                  then
                    -- No more gaps.  If the selected gap was removed, move
                    -- select to last (latest) message.
                    case Maybe MessageType
rmvdSelType of
                      Just (C ClientMessageType
UnknownGapAfter) ->
                        ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
latestPId)
                      Maybe MessageType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
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.
                    Message
gapMsg <- ServerTime -> Bool -> MH Message
newGapMessage (ServerTime -> ServerTime
justAfter ServerTime
latestDate) Bool
False
                    Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
                      (Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg)
                    -- Move selection from old gap to new gap
                    case Maybe MessageType
rmvdSelType of
                      Just (C ClientMessageType
UnknownGapAfter) ->
                        ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
gapMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
                      Maybe MessageType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

          case Maybe TeamId
mTId of
              Maybe TeamId
Nothing -> do
                  HashMap TeamId TeamState
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId TeamState)
csTeams
                  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) TeamId -> MH ()
processTeam
              Just TeamId
tId -> TeamId -> MH ()
processTeam TeamId
tId

        -- Now initiate fetches for use information for any
        -- as-yet-unknown users related to this new set of messages

        let users :: Set UserId
users = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Post
post Set UserId
s -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set UserId
s (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
Set.insert Set UserId
s) (Post -> Maybe UserId
postUserId Post
post))
                          forall a. Set a
Set.empty (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL)
            addUnknownUsers :: Set UserId -> MH ()
addUnknownUsers Set UserId
inputUserIds = do
                Set UserId
knownUserIds <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> [UserId]
allUserIds
                let unknownUsers :: Set UserId
unknownUsers = forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set UserId
inputUserIds Set UserId
knownUserIds
                if forall a. Set a -> Bool
Set.null Set UserId
unknownUsers
                   then forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   else Seq UserId -> MH () -> MH ()
handleNewUsers (forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set UserId
unknownUsers) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

        Set UserId -> MH ()
addUnknownUsers Set UserId
users

        -- Return the aggregated user notification action needed
        -- relative to the set of added messages.

        forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
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 :: Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
doFetchMentionedUsers Bool
fetchAuthor PostToAdd
newPostData = do
    let (Post
new, Bool
wasMentioned) = case PostToAdd
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 Post
p      -> (Post
p, Bool
False)
          RecentPost Post
p Bool
m -> (Post
p, Bool
m)

    Text
hostname <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources ConnectionData
crConnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ConnectionData Text
cdHostnameL)

    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    case ChatState
st forall s a. s -> Getting (First a) s a -> Maybe a
^? ChannelId -> Traversal' ChatState ClientChannel
csChannel(Post -> ChannelId
postChannelId Post
new) of
        Maybe ClientChannel
Nothing -> do
            Session
session <- MH Session
getSession
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
                Channel
nc <- ChannelId -> Session -> IO Channel
MM.mmGetChannel (Post -> ChannelId
postChannelId Post
new) Session
session
                ChannelMember
member <- ChannelId -> UserParam -> Session -> IO ChannelMember
MM.mmGetChannelMember (Post -> ChannelId
postChannelId Post
new) UserParam
UserMe Session
session

                let chType :: Type
chType = Channel
ncforall s a. s -> Getting a s a -> a
^.Lens' Channel Type
channelTypeL
                    pref :: Preference
pref = ChannelId -> UserId -> Preference
showGroupChannelPref (Post -> ChannelId
postChannelId Post
new) (ChatState -> UserId
myUserId ChatState
st)

                -- If the channel has been archived, we don't want to
                -- post this message or add the channel to the state.
                case Channel -> Bool
channelDeleted Channel
nc of
                    Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                    Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 Type
chType forall a. Eq a => a -> a -> Bool
== Type
Group
                            then Preference -> MH ()
applyPreferenceChange Preference
pref
                            else SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel SidebarUpdate
SidebarUpdateImmediate Channel
nc ChannelMember
member

                        Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
doFetchMentionedUsers Bool
fetchAuthor PostToAdd
newPostData forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                            PostProcessMessageAdd -> MH ()
postProcessMessageAdd

            forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
        Just ClientChannel
ch -> do
            let mTId :: Maybe TeamId
mTId = ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId
            Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
                Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                Just TeamId
tId -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId

            let cp :: ClientPost
cp = Text -> Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Text
hostname Maybe TeamBaseURL
mBaseUrl Post
new (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post (Maybe PostId)
postRootIdL)
                fromMe :: Bool
fromMe = (ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe UserId)
cpUser forall a. Eq a => a -> a -> Bool
== (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ChatState -> UserId
myUserId ChatState
st)) Bool -> Bool -> Bool
&&
                         (forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe Text)
cpUserOverride)
                userPrefs :: UserPreferences
userPrefs = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources UserPreferences
crUserPreferences
                isJoinOrLeave :: Bool
isJoinOrLeave = case ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost ClientPostType
cpType of
                  ClientPostType
Join  -> Bool
True
                  ClientPostType
Leave -> Bool
True
                  ClientPostType
_     -> Bool
False
                ignoredJoinLeaveMessage :: Bool
ignoredJoinLeaveMessage =
                  Bool -> Bool
not (UserPreferences
userPrefsforall s a. s -> Getting a s a -> a
^.Lens' UserPreferences Bool
userPrefShowJoinLeave) Bool -> Bool -> Bool
&& Bool
isJoinOrLeave
                cId :: ChannelId
cId = Post -> ChannelId
postChannelId Post
new

                doAddMessage :: MH PostProcessMessageAdd
doAddMessage = do
                    -- Do we have the user data for the post author?
                    case ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe UserId)
cpUser of
                        Maybe UserId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Just UserId
authorId -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fetchAuthor forall a b. (a -> b) -> a -> b
$ do
                            Maybe UserInfo
authorResult <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (UserId -> ChatState -> Maybe UserInfo
userById UserId
authorId)
                            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe UserInfo
authorResult) forall a b. (a -> b) -> a -> b
$
                                Seq UserId -> MH () -> MH ()
handleNewUsers (forall a. a -> Seq a
Seq.singleton UserId
authorId) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

                    Maybe TeamId
mcurTId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
                    Maybe ChannelId
currCId <- case Maybe TeamId
mcurTId of
                        Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                        Just TeamId
curTId -> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
curTId)

                    Set PostId
flags <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (Set PostId)
crFlaggedPosts)
                    let (Message
msg', Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage ClientPost
cp
                                 forall a b. a -> (a -> b) -> b
& forall s t a b. Field1 s t a b => Lens s t a b
_1forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Message Bool
mFlagged forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost PostId
cpPostId) forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PostId
flags)

                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doFetchMentionedUsers forall a b. (a -> b) -> a -> b
$
                        Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentionedUsers

                    Lens' ChatState (HashMap PostId Message)
csPostMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at(Post -> PostId
postId Post
new) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Message
msg'
                    ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
                    PostId -> MH ()
invalidateMessageRenderingCacheByPostId forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new
                    Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
                      ((Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. MessageOps a => Message -> a -> a
addMessage Message
msg') forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       (if Bool -> Bool
not Bool
ignoredJoinLeaveMessage then Post -> ClientChannel -> ClientChannel
adjustUpdated Post
new else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       (\ClientChannel
c -> if Maybe ChannelId
currCId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ChannelId
cId
                              then ClientChannel
c
                              else case PostToAdd
newPostData of
                                     OldPost Post
_ -> ClientChannel
c
                                     RecentPost Post
_ Bool
_ ->
                                       Post -> ClientChannel -> ClientChannel
updateNewMessageIndicator Post
new ClientChannel
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       (\ClientChannel
c -> if Bool
wasMentioned
                              then ClientChannel
c forall a b. a -> (a -> b) -> b
& Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Int
cdMentionCount forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Enum a => a -> a
succ
                              else ClientChannel
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.
                    Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread (Maybe TeamId
mTId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TeamId
mcurTId) Post
new Message
msg'

                    MH PostProcessMessageAdd
postedChanMessage

                doHandleAddedMessage :: MH PostProcessMessageAdd
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 ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe PostId)
cpInReplyToPost of
                        Just PostId
parentId ->
                            case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
parentId of
                                Maybe Message
Nothing -> do
                                    forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
                                        (\Session
s ChannelId
_ -> PostId -> Session -> IO Posts
MM.mmGetThread PostId
parentId Session
s)
                                        (\ChannelId
_ Posts
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe TeamId -> Posts -> MH ()
updatePostMap Maybe TeamId
mTId Posts
p)
                                Maybe Message
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Maybe PostId
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

                    MH PostProcessMessageAdd
doAddMessage

                postedChanMessage :: MH PostProcessMessageAdd
postedChanMessage =
                  forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault (Post -> ChannelId
postChannelId Post
new) PostProcessMessageAdd
NoAction forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
                      Maybe TeamId
mcurrTid <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
                      case Maybe TeamId
mcurrTid of
                          Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
                          Just TeamId
currTid -> do
                              Maybe ChannelId
currCId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
currTid)

                              let notifyPref :: NotifyOption
notifyPref = User -> ClientChannel -> NotifyOption
notifyPreference (ChatState -> User
myUser ChatState
st) ClientChannel
chan
                                  curChannelAction :: PostProcessMessageAdd
curChannelAction = if forall a. a -> Maybe a
Just (Post -> ChannelId
postChannelId Post
new) forall a. Eq a => a -> a -> Bool
== Maybe ChannelId
currCId
                                                     then PostProcessMessageAdd
UpdateServerViewed
                                                     else PostProcessMessageAdd
NoAction
                                  originUserAction :: PostProcessMessageAdd
originUserAction =
                                    if | Bool
fromMe                            -> PostProcessMessageAdd
NoAction
                                       | Bool
ignoredJoinLeaveMessage           -> PostProcessMessageAdd
NoAction
                                       | NotifyOption
notifyPref forall a. Eq a => a -> a -> Bool
== NotifyOption
NotifyOptionAll     -> [PostToAdd] -> PostProcessMessageAdd
NotifyUser [PostToAdd
newPostData]
                                       | NotifyOption
notifyPref forall a. Eq a => a -> a -> Bool
== NotifyOption
NotifyOptionMention
                                           Bool -> Bool -> Bool
&& Bool
wasMentioned                 -> [PostToAdd] -> PostProcessMessageAdd
NotifyUser [PostToAdd
newPostData]
                                       | Bool
otherwise                         -> PostProcessMessageAdd
NoAction

                              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PostProcessMessageAdd
curChannelAction PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
`andProcessWith` PostProcessMessageAdd
originUserAction

            MH PostProcessMessageAdd
doHandleAddedMessage

addPostToOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread Maybe TeamId
Nothing Post
_ Message
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
addPostToOpenThread (Just TeamId
tId) Post
new Message
msg =
    case Post -> Maybe PostId
postRootId Post
new of
        Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PostId
parentId -> do
            Maybe PostId
mRoot <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i1 i2.
Lens (MessageInterface n i1) (MessageInterface n i2) i1 i2
miRootPostId)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PostId
mRoot forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just PostId
parentId) forall a b. (a -> b) -> a -> b
$
                TeamId -> ChannelId -> (Messages -> Messages) -> MH ()
modifyThreadMessages TeamId
tId (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) (forall a. MessageOps a => Message -> a -> a
addMessage Message
msg)

editPostInOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread Maybe TeamId
Nothing Post
_ Message
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
editPostInOpenThread (Just TeamId
tId) Post
new Message
msg =
     case Post -> Maybe PostId
postRootId Post
new of
        Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PostId
parentId -> do
            Maybe PostId
mRoot <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i1 i2.
Lens (MessageInterface n i1) (MessageInterface n i2) i1 i2
miRootPostId)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PostId
mRoot forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just PostId
parentId) forall a b. (a -> b) -> a -> b
$ do
                LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral Text
"editPostInOpenThread: updating message"
                let isEditedMessage :: Message -> Bool
isEditedMessage Message
m = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL)
                TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage TeamId
tId (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL)
                    (\Message
m -> if Message -> Bool
isEditedMessage Message
m then Message
msg else Message
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 :: PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
andProcessWith PostProcessMessageAdd
NoAction PostProcessMessageAdd
x                                        = PostProcessMessageAdd
x
andProcessWith PostProcessMessageAdd
x PostProcessMessageAdd
NoAction                                        = PostProcessMessageAdd
x
andProcessWith (NotifyUserAndServer [PostToAdd]
p) PostProcessMessageAdd
UpdateServerViewed        = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer [PostToAdd]
p
andProcessWith (NotifyUserAndServer [PostToAdd]
p1) (NotifyUser [PostToAdd]
p2)          = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer ([PostToAdd]
p1 forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUserAndServer [PostToAdd]
p1) (NotifyUserAndServer [PostToAdd]
p2) = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer ([PostToAdd]
p1 forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUser [PostToAdd]
p1) (NotifyUserAndServer [PostToAdd]
p2)          = [PostToAdd] -> PostProcessMessageAdd
NotifyUser ([PostToAdd]
p1 forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUser [PostToAdd]
p1) (NotifyUser [PostToAdd]
p2)                   = [PostToAdd] -> PostProcessMessageAdd
NotifyUser ([PostToAdd]
p1 forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUser [PostToAdd]
p) PostProcessMessageAdd
UpdateServerViewed                 = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer [PostToAdd]
p
andProcessWith PostProcessMessageAdd
UpdateServerViewed PostProcessMessageAdd
UpdateServerViewed             = PostProcessMessageAdd
UpdateServerViewed
andProcessWith PostProcessMessageAdd
UpdateServerViewed (NotifyUserAndServer [PostToAdd]
p)        = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer [PostToAdd]
p
andProcessWith PostProcessMessageAdd
UpdateServerViewed (NotifyUser [PostToAdd]
p)                 = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer [PostToAdd]
p

-- | postProcessMessageAdd performs the actual actions indicated by
-- the corresponding input value.
postProcessMessageAdd :: PostProcessMessageAdd -> MH ()
postProcessMessageAdd :: PostProcessMessageAdd -> MH ()
postProcessMessageAdd PostProcessMessageAdd
ppma = PostProcessMessageAdd -> MH ()
postOp PostProcessMessageAdd
ppma
    where
        postOp :: PostProcessMessageAdd -> MH ()
postOp PostProcessMessageAdd
NoAction                = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        postOp PostProcessMessageAdd
UpdateServerViewed      = Bool -> MH ()
updateViewed Bool
False
        postOp (NotifyUser [PostToAdd]
p)          = MH ()
maybeRingBell forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PostToAdd -> MH ()
maybeNotify [PostToAdd]
p
        postOp (NotifyUserAndServer [PostToAdd]
p) = Bool -> MH ()
updateViewed Bool
False forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MH ()
maybeRingBell forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PostToAdd -> MH ()
maybeNotify [PostToAdd]
p

maybeNotify :: PostToAdd -> MH ()
maybeNotify :: PostToAdd -> MH ()
maybeNotify (OldPost Post
_) = do
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
maybeNotify (RecentPost Post
post Bool
mentioned) = Post -> Bool -> MH ()
runNotifyCommand Post
post Bool
mentioned

maybeRingBell :: MH ()
maybeRingBell :: MH ()
maybeRingBell = do
    Bool
doBell <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config Bool
configActivityBellL)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doBell forall a b. (a -> b) -> a -> b
$ do
        Vty
vty <- forall a. EventM Name ChatState a -> MH a
mh forall n s. EventM n s Vty
getVtyHandle
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Output -> IO ()
ringTerminalBell forall a b. (a -> b) -> a -> b
$ Vty -> Output
outputIface Vty
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
    { NotificationV2 -> Int
version :: Int
    , NotificationV2 -> Text
message :: Text
    , NotificationV2 -> Bool
mention :: Bool
    , NotificationV2 -> Text
from :: Text
    } deriving (Int -> NotificationV2 -> ShowS
[NotificationV2] -> ShowS
NotificationV2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationV2] -> ShowS
$cshowList :: [NotificationV2] -> ShowS
show :: NotificationV2 -> String
$cshow :: NotificationV2 -> String
showsPrec :: Int -> NotificationV2 -> ShowS
$cshowsPrec :: Int -> NotificationV2 -> ShowS
Show)

instance A.ToJSON NotificationV2 where
    toJSON :: NotificationV2 -> Value
toJSON (NotificationV2 Int
vers Text
msg Bool
mentioned Text
sender) =
        [Pair] -> Value
A.object [ Key
"version"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
vers
                 , Key
"message"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
msg
                 , Key
"mention"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
mentioned
                 , Key
"from"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
sender
                 ]

-- Notification Version 3 payload definition
data NotificationV3 = NotificationV3
    { NotificationV3 -> Int
notifyV3Version :: Int
    , NotificationV3 -> Text
notifyV3Message :: Text
    , NotificationV3 -> Bool
notifyV3Mention :: Bool
    , NotificationV3 -> Text
notifyV3From :: Text
    , NotificationV3 -> Text
notifyV3MessageType :: Text
    } deriving (Int -> NotificationV3 -> ShowS
[NotificationV3] -> ShowS
NotificationV3 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationV3] -> ShowS
$cshowList :: [NotificationV3] -> ShowS
show :: NotificationV3 -> String
$cshow :: NotificationV3 -> String
showsPrec :: Int -> NotificationV3 -> ShowS
$cshowsPrec :: Int -> NotificationV3 -> ShowS
Show)

instance A.ToJSON NotificationV3 where
    toJSON :: NotificationV3 -> Value
toJSON (NotificationV3 Int
vers Text
msg Bool
mentioned Text
sender Text
msgTy) =
        [Pair] -> Value
A.object [ Key
"version"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
vers
                 , Key
"message"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
msg
                 , Key
"mention"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
mentioned
                 , Key
"from"        forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
sender
                 , Key
"messageType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
msgTy
                 ]

-- We define a notifyGetPayload for each notification version.
notifyGetPayload :: NotificationVersion -> ChatState -> Post -> Bool -> Maybe BSL.ByteString
notifyGetPayload :: NotificationVersion
-> ChatState -> Post -> Bool -> Maybe ByteString
notifyGetPayload NotificationVersion
NotifyV1 ChatState
_ Post
_ Bool
_ = do forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
notifyGetPayload NotificationVersion
NotifyV2 ChatState
st Post
post Bool
mentioned = do
    let notification :: NotificationV2
notification = Int -> Text -> Bool -> Text -> NotificationV2
NotificationV2 Int
2 Text
msg Bool
mentioned Text
sender
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ToJSON a => a -> ByteString
A.encode NotificationV2
notification)
        where
            msg :: Text
msg = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
            sender :: Text
sender = ChatState -> Post -> Text
maybePostUsername ChatState
st Post
post
notifyGetPayload NotificationVersion
NotifyV3 ChatState
st Post
post Bool
mentioned = do
    let notification :: NotificationV3
notification = Int -> Text -> Bool -> Text -> Text -> NotificationV3
NotificationV3 Int
3 Text
msg Bool
mentioned Text
sender Text
msgTy
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ToJSON a => a -> ByteString
A.encode NotificationV3
notification)
        where
            msg :: Text
msg = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
            sender :: Text
sender = ChatState -> Post -> Text
maybePostUsername ChatState
st Post
post
            msgTy :: Text
msgTy = case Post -> PostType
postType Post
post of
                PostType
PostTypeJoinChannel       -> Text
"joinChannel"
                PostType
PostTypeLeaveChannel      -> Text
"leaveChannel"
                PostType
PostTypeAddToChannel      -> Text
"addToChannel"
                PostType
PostTypeRemoveFromChannel -> Text
"removeFromChannel"
                PostType
PostTypeHeaderChange      -> Text
"headerChange"
                PostType
PostTypeDisplayNameChange -> Text
"displayNameChange"
                PostType
PostTypePurposeChange     -> Text
"purposeChange"
                PostType
PostTypeChannelDeleted    -> Text
"channelDeleted"
                PostType
PostTypeEphemeral         -> Text
"ephemeral"
                PostTypeUnknown Text
_         -> Text
"unknown"

handleNotifyCommand :: Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand :: Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV1 = do
    TChan ProgramOutput
outputChan <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    Maybe Text
notifyCommand <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Text)
configActivityNotifyCommandL)
    case Maybe Text
notifyCommand of
        Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Text
cmd ->
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
                let messageString :: String
messageString = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
                    notified :: String
notified = if Bool
mentioned then String
"1" else String
"2"
                    sender :: String
sender = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ ChatState -> Post -> Text
maybePostUsername ChatState
st Post
post
                TChan ProgramOutput
-> String
-> [String]
-> Maybe ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd)
                                 [String
notified, String
sender, String
messageString] forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV2 = do
    TChan ProgramOutput
outputChan <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    let payload :: Maybe ByteString
payload = NotificationVersion
-> ChatState -> Post -> Bool -> Maybe ByteString
notifyGetPayload NotificationVersion
NotifyV2 ChatState
st Post
post Bool
mentioned
    Maybe Text
notifyCommand <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Text)
configActivityNotifyCommandL)
    case Maybe Text
notifyCommand of
        Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Text
cmd ->
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
                TChan ProgramOutput
-> String
-> [String]
-> Maybe ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd) [] Maybe ByteString
payload forall a. Maybe a
Nothing
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV3 = do
    TChan ProgramOutput
outputChan <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    let payload :: Maybe ByteString
payload = NotificationVersion
-> ChatState -> Post -> Bool -> Maybe ByteString
notifyGetPayload NotificationVersion
NotifyV3 ChatState
st Post
post Bool
mentioned
    Maybe Text
notifyCommand <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Text)
configActivityNotifyCommandL)
    case Maybe Text
notifyCommand of
        Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Text
cmd ->
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
                TChan ProgramOutput
-> String
-> [String]
-> Maybe ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd) [] Maybe ByteString
payload forall a. Maybe a
Nothing
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand Post
post Bool
mentioned = do
    NotificationVersion
notifyVersion <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config NotificationVersion
configActivityNotifyVersionL)
    Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
notifyVersion

maybePostUsername :: ChatState -> Post -> T.Text
maybePostUsername :: ChatState -> Post -> Text
maybePostUsername ChatState
st Post
p =
    forall a. a -> Maybe a -> a
fromMaybe Text
T.empty forall a b. (a -> b) -> a -> b
$ do
        UserId
uId <- Post -> Maybe UserId
postUserId Post
p
        UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId ChatState
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 :: MH ()
asyncFetchMoreMessages =
    (TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
        TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
chan -> do
            let offset :: Int
offset = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages) forall a. Num a => a -> a -> a
- Int
2
                page :: Int
page = Int
offset forall a. Integral a => a -> a -> a
`div` Int
pageAmount
                usefulMsgs :: Maybe (Message, Message)
usefulMsgs = forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts forall a. Maybe a
Nothing (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessages)
                sndOldestId :: Maybe PostId
sndOldestId = (Message -> Maybe PostId
messagePostId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Message, Message)
usefulMsgs
                query :: PostQuery
query = PostQuery
MM.defaultPostQuery
                          { postQueryPage :: Maybe Int
MM.postQueryPage = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just Int
page) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) Maybe PostId
sndOldestId
                          , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just Int
pageAmount
                          , postQueryBefore :: Maybe PostId
MM.postQueryBefore = Maybe PostId
sndOldestId
                          }
                addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
query forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                                 PostQuery -> Maybe Int
MM.postQueryPage PostQuery
query forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0
            forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
                (\Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
query Session
s)
                (\ChannelId
c Posts
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                    PostProcessMessageAdd
pp <- ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
pageAmount) Bool
addTrailingGap Posts
p
                    PostProcessMessageAdd -> MH ()
postProcessMessageAdd 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 :: forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
startMsg DirectionalSeq dir Message
msgs =
  let go :: Maybe Message -> Maybe (Message, Message)
go Maybe Message
start =
        do Message
anchor <- forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId (Message -> Maybe MessageId
_mMessageId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Message
start) DirectionalSeq dir Message
msgs
           Message
hinge <- forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId (Message
anchorforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId) DirectionalSeq dir Message
msgs
           if Message -> Bool
isGap Message
anchor Bool -> Bool -> Bool
|| Message -> Bool
isGap Message
hinge
             then Maybe Message -> Maybe (Message, Message)
go forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Message
anchor
             else forall a. a -> Maybe a
Just (Message
anchor, Message
hinge)
  in Maybe Message -> Maybe (Message, Message)
go Maybe Message
startMsg


asyncFetchMessagesForGap :: ChannelId -> Message -> MH ()
asyncFetchMessagesForGap :: ChannelId -> Message -> MH ()
asyncFetchMessagesForGap ChannelId
cId Message
gapMessage =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isGap Message
gapMessage) forall a b. (a -> b) -> a -> b
$
  ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
    let offset :: Int
offset = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages) forall a. Num a => a -> a -> a
- Int
2
        page :: Int
page = Int
offset forall a. Integral a => a -> a -> a
`div` Int
pageAmount
        chanMsgs :: Messages
chanMsgs = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages
        fromMsg :: Maybe Message
fromMsg = forall a. a -> Maybe a
Just Message
gapMessage
        fetchNewer :: Bool
fetchNewer = case Message
gapMessageforall s a. s -> Getting a s a -> a
^.Lens' Message MessageType
mType of
                       C ClientMessageType
UnknownGapAfter -> Bool
True
                       C ClientMessageType
UnknownGapBefore -> Bool
False
                       MessageType
_ -> forall a. HasCallStack => String -> a
error String
"fetch gap messages: unknown gap message type"
        baseId :: Maybe PostId
baseId = Message -> Maybe PostId
messagePostId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                 case Message
gapMessageforall s a. s -> Getting a s a -> a
^.Lens' Message MessageType
mType of
                    C ClientMessageType
UnknownGapAfter -> forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
fromMsg forall a b. (a -> b) -> a -> b
$
                                         Messages -> RetrogradeMessages
reverseMessages Messages
chanMsgs
                    C ClientMessageType
UnknownGapBefore -> forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
fromMsg Messages
chanMsgs
                    MessageType
_ -> forall a. HasCallStack => String -> a
error String
"fetch gap messages: unknown gap message type"
        query :: PostQuery
query = PostQuery
MM.defaultPostQuery
                { postQueryPage :: Maybe Int
MM.postQueryPage = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just Int
page) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) Maybe PostId
baseId
                , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just Int
pageAmount
                , postQueryBefore :: Maybe PostId
MM.postQueryBefore = if Bool
fetchNewer then forall a. Maybe a
Nothing else Maybe PostId
baseId
                , postQueryAfter :: Maybe PostId
MM.postQueryAfter = if Bool
fetchNewer then Maybe PostId
baseId else forall a. Maybe a
Nothing
                }
        addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
query forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                         PostQuery -> Maybe Int
MM.postQueryPage PostQuery
query forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0
    in forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
       (\Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
query Session
s)
       (\ChannelId
c Posts
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
           forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
pageAmount) Bool
addTrailingGap Posts
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 :: ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding ChannelId
cId PostId
pId = do
    let query :: PostQuery
query = PostQuery
MM.defaultPostQuery
          { postQueryBefore :: Maybe PostId
MM.postQueryBefore = forall a. a -> Maybe a
Just PostId
pId
          , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just Int
reqAmt
          }
        reqAmt :: Int
reqAmt = Int
5  -- both before and after
    forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
      -- first get some messages before the target, no overlap
      (\Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
query Session
s)
      (\ChannelId
c Posts
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
          let last2ndId :: Maybe PostId
last2ndId = Posts -> Maybe PostId
secondToLastPostId Posts
p
          forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
reqAmt) Bool
False Posts
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' :: PostQuery
query' = PostQuery
MM.defaultPostQuery
                       { postQueryAfter :: Maybe PostId
MM.postQueryAfter = Maybe PostId
last2ndId
                       , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
reqAmt forall a. Num a => a -> a -> a
+ Int
2
                       }
          forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
            (\Session
s' ChannelId
c' -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c' PostQuery
query' Session
s')
            (\ChannelId
c' Posts
p' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c' (Int
reqAmt forall a. Num a => a -> a -> a
+ Int
2) Bool
False Posts
p'
            )
      )
      where secondToLastPostId :: Posts -> Maybe PostId
secondToLastPostId Posts
posts =
              let pl :: [PostId]
pl = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Posts -> Seq PostId
postsOrder Posts
posts
              in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pl forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [PostId]
pl else forall a. Maybe a
Nothing

fetchVisibleIfNeeded :: TeamId -> MH ()
fetchVisibleIfNeeded :: TeamId -> MH ()
fetchVisibleIfNeeded TeamId
tId = do
    ConnectionStatus
sts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ConnectionStatus
csConnectionStatus
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionStatus
sts forall a. Eq a => a -> a -> Bool
== ConnectionStatus
Connected) forall a b. (a -> b) -> a -> b
$ do
        TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
chan -> do
            let msgs :: RetrogradeMessages
msgs = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessages
                (Int
numRemaining, Bool
gapInDisplayable, Maybe MessageId
_, Maybe MessageId
rel'pId, Int
overlap) =
                    forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> Message -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
gapTrail (Int
numScrollbackPosts, Bool
False, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, Int
2) RetrogradeMessages
msgs

                gapTrail :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
                         -> Message
                         -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
                gapTrail :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> Message -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
gapTrail a :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a@(Int
_,  Bool
True, Maybe MessageId
_, Maybe MessageId
_, Int
_) Message
_ = (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a
                gapTrail a :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a@(Int
0,     Bool
_, Maybe MessageId
_, Maybe MessageId
_, Int
_) Message
_ = (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a
                gapTrail   (Int
a, Bool
False, Maybe MessageId
b, Maybe MessageId
c, Int
d) Message
m | Message -> Bool
isGap Message
m = (Int
a, Bool
True, Maybe MessageId
b, Maybe MessageId
c, Int
d)
                gapTrail (Int
remCnt, Bool
_, Maybe MessageId
prev'pId, Maybe MessageId
prev''pId, Int
ovl) Message
msg =
                    (Int
remCnt forall a. Num a => a -> a -> a
- Int
1, Bool
False, Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
prev'pId, Maybe MessageId
prev'pId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
prev''pId,
                     Int
ovl forall a. Num a => a -> a -> a
+ if Bool -> Bool
not (Message -> Bool
isPostMessage Message
msg) then Int
1 else Int
0)

                numToRequest :: Int
numToRequest = Int
numRemaining forall a. Num a => a -> a -> a
+ Int
overlap
                query :: PostQuery
query = PostQuery
MM.defaultPostQuery
                        { postQueryPage :: Maybe Int
MM.postQueryPage    = forall a. a -> Maybe a
Just Int
0
                        , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just Int
numToRequest
                        }
                finalQuery :: PostQuery
finalQuery = case Maybe MessageId
rel'pId of
                               Just (MessagePostId PostId
pid) -> PostQuery
query { postQueryBefore :: Maybe PostId
MM.postQueryBefore = forall a. a -> Maybe a
Just PostId
pid }
                               Maybe MessageId
_ -> PostQuery
query
                op :: Session -> ChannelId -> IO Posts
op = \Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
finalQuery Session
s
                addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
finalQuery forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                                 PostQuery -> Maybe Int
MM.postQueryPage PostQuery
finalQuery forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Bool
cdFetchPending) Bool -> Bool -> Bool
&& Bool
gapInDisplayable) forall a b. (a -> b) -> a -> b
$ do
                   ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Bool
cdFetchPending forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                   forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId Session -> ChannelId -> IO Posts
op
                       (\ChannelId
c Posts
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                           ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
c)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Bool
cdFetchPending forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
                           ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
numToRequest) Bool
addTrailingGap Posts
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PostProcessMessageAdd -> MH ()
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 :: PostId -> MH ()
jumpToPost PostId
pId = (TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
pId of
      Just Message
msg ->
        case Message
msg forall s a. s -> Getting a s a -> a
^. Lens' Message (Maybe ChannelId)
mChannelId of
          Just ChannelId
cId -> do
              -- Are we a member of the channel?
              case ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels) of
                  Maybe ClientChannel
Nothing ->
                      TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' TeamId
tId ChannelId
cId (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PostId -> MH ()
jumpToPost PostId
pId)
                  Just ClientChannel
_ -> do
                      TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
                      forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect (ChannelId -> Lens' ChatState (MessageInterface Name ())
csChannelMessageInterface(ChannelId
cId))
                      ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
          Maybe ChannelId
Nothing ->
            forall a. HasCallStack => String -> a
error String
"INTERNAL: selected Post ID not associated with a channel"
      Maybe Message
Nothing -> do
          Session
session <- MH Session
getSession
          AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
              Either SomeException Post
result <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ PostId -> Session -> IO Post
MM.mmGetPost PostId
pId Session
session
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                  case Either SomeException Post
result of
                      Right Post
p -> do
                          -- Are we a member of the channel?
                          case ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById (Post -> ChannelId
postChannelId Post
p) (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels) of
                              -- If not, join it and then try jumping to
                              -- the post if the channel join is successful.
                              Maybe ClientChannel
Nothing -> do
                                  TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' TeamId
tId (Post -> ChannelId
postChannelId Post
p) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PostId -> MH ()
jumpToPost PostId
pId)
                              -- Otherwise add the post to the state and
                              -- then jump.
                              Just ClientChannel
_ -> do
                                  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
True Bool
True (Post -> PostToAdd
OldPost Post
p)
                                  PostId -> MH ()
jumpToPost PostId
pId
                      Left (SomeException
_::SomeException) ->
                          Text -> MH ()
postErrorMessage' Text
"Could not fetch linked post"