{-# 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.Reactions
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 = Hostname -> MessageType -> ServerTime -> Message
newMessageOfType
                        (String -> Hostname
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 -> Hostname -> [AttachmentData] -> MH ()
sendMessage ChannelId
chanId EditMode
mode Hostname
msg [AttachmentData]
attachments =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Hostname -> Bool
shouldSkipMessage Hostname
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 :: Hostname
m = [Hostname] -> Hostname
T.concat [ Hostname
"Cannot send messages while disconnected. Enable logging to "
                                 , Hostname
"get disconnection information. If Matterhorn's reconnection "
                                 , Hostname
"attempts are failing, use `/reconnect` to attempt to "
                                 , Hostname
"reconnect manually."
                                 ]
                MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Hostname -> MHError
GenericError Hostname
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 = (Hostname -> ChannelId -> RawPost
rawPost Hostname
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 = (Hostname -> ChannelId -> RawPost
rawPost Hostname
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 :: Hostname
body = case MessageType
ty of
                                         CP ClientPostType
Emote -> Hostname -> Hostname
addEmoteFormatting Hostname
msg
                                         MessageType
_ -> Hostname
msg
                                update :: PostUpdate
update = (Hostname -> PostUpdate
postUpdateBody Hostname
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 :: Hostname -> Bool
shouldSkipMessage Hostname
"" = Bool
True
shouldSkipMessage Hostname
s = (Char -> Bool) -> Hostname -> Bool
T.all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t"::String)) Hostname
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

        let (Message
msg, Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage (Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost 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
        ChannelId -> Post -> MH ()
asyncFetchReactionsForPost (Post -> ChannelId
postChannelId Post
new) Post
new
        Post -> MH ()
asyncFetchAttachments Post
new

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
            Hostname -> MH ()
postInfoMessage Hostname
"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 :: Hostname
txt = Hostname
"Load " forall a. Semigroup a => a -> a -> a
<>
                           (if Bool
isOlder then Hostname
"older" else Hostname
"newer") forall a. Semigroup a => a -> a -> a
<>
                           Hostname
" messages" forall a. Semigroup a => a -> a -> a
<>
                           (if Bool
isOlder then Hostname
"  ↥↥↥" else Hostname
"  ↧↧↧")
                     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 (Hostname -> MessageType -> ServerTime -> Message
newMessageOfType Hostname
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)

    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 = Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost 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 Hostname)
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'

                    ChannelId -> Post -> MH ()
asyncFetchReactionsForPost ChannelId
cId Post
new
                    Post -> MH ()
asyncFetchAttachments Post
new
                    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 -> Hostname -> MH ()
mhLog LogCategory
LogGeneral Hostname
"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 -> Hostname
message :: Text
    , NotificationV2 -> Bool
mention :: Bool
    , NotificationV2 -> Hostname
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 Hostname
msg Bool
mentioned Hostname
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..= Hostname
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..= Hostname
sender
                 ]

-- Notification Version 3 payload definition
data NotificationV3 = NotificationV3
    { NotificationV3 -> Int
notifyV3Version :: Int
    , NotificationV3 -> Hostname
notifyV3Message :: Text
    , NotificationV3 -> Bool
notifyV3Mention :: Bool
    , NotificationV3 -> Hostname
notifyV3From :: Text
    , NotificationV3 -> Hostname
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 Hostname
msg Bool
mentioned Hostname
sender Hostname
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..= Hostname
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..= Hostname
sender
                 , Key
"messageType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Hostname
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 -> Hostname -> Bool -> Hostname -> NotificationV2
NotificationV2 Int
2 Hostname
msg Bool
mentioned Hostname
sender
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ToJSON a => a -> ByteString
A.encode NotificationV2
notification)
        where
            msg :: Hostname
msg = UserText -> Hostname
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
            sender :: Hostname
sender = ChatState -> Post -> Hostname
maybePostUsername ChatState
st Post
post
notifyGetPayload NotificationVersion
NotifyV3 ChatState
st Post
post Bool
mentioned = do
    let notification :: NotificationV3
notification = Int -> Hostname -> Bool -> Hostname -> Hostname -> NotificationV3
NotificationV3 Int
3 Hostname
msg Bool
mentioned Hostname
sender Hostname
msgTy
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ToJSON a => a -> ByteString
A.encode NotificationV3
notification)
        where
            msg :: Hostname
msg = UserText -> Hostname
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
            sender :: Hostname
sender = ChatState -> Post -> Hostname
maybePostUsername ChatState
st Post
post
            msgTy :: Hostname
msgTy = case Post -> PostType
postType Post
post of
                PostType
PostTypeJoinChannel       -> Hostname
"joinChannel"
                PostType
PostTypeLeaveChannel      -> Hostname
"leaveChannel"
                PostType
PostTypeAddToChannel      -> Hostname
"addToChannel"
                PostType
PostTypeRemoveFromChannel -> Hostname
"removeFromChannel"
                PostType
PostTypeHeaderChange      -> Hostname
"headerChange"
                PostType
PostTypeDisplayNameChange -> Hostname
"displayNameChange"
                PostType
PostTypePurposeChange     -> Hostname
"purposeChange"
                PostType
PostTypeChannelDeleted    -> Hostname
"channelDeleted"
                PostType
PostTypeEphemeral         -> Hostname
"ephemeral"
                PostTypeUnknown Hostname
_         -> Hostname
"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 Hostname
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 Hostname)
configActivityNotifyCommandL)
    case Maybe Hostname
notifyCommand of
        Maybe Hostname
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Hostname
cmd ->
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
                let messageString :: String
messageString = Hostname -> String
T.unpack forall a b. (a -> b) -> a -> b
$ UserText -> Hostname
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 = Hostname -> String
T.unpack forall a b. (a -> b) -> a -> b
$ ChatState -> Post -> Hostname
maybePostUsername ChatState
st Post
post
                TChan ProgramOutput
-> String
-> [String]
-> Maybe ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Hostname -> String
T.unpack Hostname
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 Hostname
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 Hostname)
configActivityNotifyCommandL)
    case Maybe Hostname
notifyCommand of
        Maybe Hostname
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Hostname
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 (Hostname -> String
T.unpack Hostname
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 Hostname
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 Hostname)
configActivityNotifyCommandL)
    case Maybe Hostname
notifyCommand of
        Maybe Hostname
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Hostname
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 (Hostname -> String
T.unpack Hostname
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 -> Hostname
maybePostUsername ChatState
st Post
p =
    forall a. a -> Maybe a -> a
fromMaybe Hostname
T.empty forall a b. (a -> b) -> a -> b
$ do
        UserId
uId <- Post -> Maybe UserId
postUserId Post
p
        UserId -> ChatState -> Maybe Hostname
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)

asyncFetchAttachments :: Post -> MH ()
asyncFetchAttachments :: Post -> MH ()
asyncFetchAttachments Post
p = do
    let cId :: ChannelId
cId = Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL
        pId :: PostId
pId = Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL
    Session
session <- MH Session
getSession
    Hostname
host <- 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 Hostname
cdHostnameL)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post (Seq FileId)
postFileIdsL) forall a b. (a -> b) -> a -> b
$ \FileId
fId -> AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
        FileInfo
info <- FileId -> Session -> IO FileInfo
MM.mmGetMetadataForFile FileId
fId Session
session
        let scheme :: Hostname
scheme = Hostname
"https://"
            attUrl :: Hostname
attUrl = Hostname
scheme forall a. Semigroup a => a -> a -> a
<> Hostname
host forall a. Semigroup a => a -> a -> a
<> FileId -> Hostname
urlForFile FileId
fId
            attachment :: Attachment
attachment = Hostname -> Hostname -> FileId -> Attachment
mkAttachment (FileInfo -> Hostname
fileInfoName FileInfo
info) Hostname
attUrl FileId
fId
            addIfMissing :: a -> Seq a -> Seq a
addIfMissing a
a Seq a
as =
                if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL a
a Seq a
as
                then a
a forall a. a -> Seq a -> Seq a
Seq.<| Seq a
as
                else Seq a
as
            addAttachment :: Message -> Message
addAttachment 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 PostId
pId) =
                    Message
m forall a b. a -> (a -> b) -> b
& Lens' Message (Seq Attachment)
mAttachments forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall {a}. Eq a => a -> Seq a -> Seq a
addIfMissing Attachment
attachment)
                | Bool
otherwise =
                    Message
m
        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
            ChannelId -> Traversal' ChatState Messages
csChannelMessages(ChannelId
cId)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 s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Message -> Message
addAttachment

            Maybe TeamId
curTId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
            ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TeamId
curTId
                case Maybe TeamId
mTId of
                    Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just TeamId
tId -> TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage TeamId
tId ChannelId
cId Message -> Message
addAttachment

            ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
            PostId -> MH ()
invalidateMessageRenderingCacheByPostId PostId
pId

-- | 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) ->
                          Hostname -> MH ()
postErrorMessage' Hostname
"Could not fetch linked post"