mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
core: chat list pagination (#3505)
* add pagination args to APIGetChats * add search to chat list API * rename arg to paginationTs_ to match type * lift another condition to ids query * collect all chat refs before sorting, then get details * split remaining preview functions * roll back to collecting ids first with query cleanup * add connection join back to filter out groups * extract and expand tests * add fav/unread args * WIP * lay out the queries with favs * tweak tests * add fav tests * fix order by in the before case * build query footer wholly from pagination * add migration for direct contacts * fix setting contact_used * fix setting contact_used for group link contacts * align search x filters space with UI, support filter by either favorite or unread, optimize queries, indexes * always set chat_ts, fix tests * refactor tests * fix pagination logic, more tests * refactor, rename * increase default pagination count * comments * refactor * comment * report errors * refactor * remove unused type --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko
GitHub
parent
f65b8a9e78
commit
35c1975d66
18 changed files with 805 additions and 302 deletions
|
|
@ -125,6 +125,7 @@ library
|
|||
Simplex.Chat.Migrations.M20231113_group_forward
|
||||
Simplex.Chat.Migrations.M20231114_remote_control
|
||||
Simplex.Chat.Migrations.M20231126_remote_ctrl_address
|
||||
Simplex.Chat.Migrations.M20231207_chat_list_pagination
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.File
|
||||
Simplex.Chat.Mobile.Shared
|
||||
|
|
@ -532,6 +533,7 @@ test-suite simplex-chat-test
|
|||
Bots.DirectoryTests
|
||||
ChatClient
|
||||
ChatTests
|
||||
ChatTests.ChatList
|
||||
ChatTests.Direct
|
||||
ChatTests.Files
|
||||
ChatTests.Groups
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ import qualified Data.ByteString.Char8 as B
|
|||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Char
|
||||
import Data.Constraint (Dict (..))
|
||||
import Data.Either (fromRight, rights)
|
||||
import Data.Either (fromRight, partitionEithers, rights)
|
||||
import Data.Fixed (div')
|
||||
import Data.Functor (($>))
|
||||
import Data.Int (Int64)
|
||||
|
|
@ -596,8 +596,10 @@ processChatCommand = \case
|
|||
. sortOn (timeAvg . snd)
|
||||
. M.assocs
|
||||
<$> withConnection st (readTVarIO . DB.slow)
|
||||
APIGetChats userId withPCC -> withUserId userId $ \user ->
|
||||
CRApiChats user <$> withStoreCtx' (Just "APIGetChats, getChatPreviews") (\db -> getChatPreviews db user withPCC)
|
||||
APIGetChats {userId, pendingConnections, pagination, query} -> withUserId userId $ \user -> do
|
||||
(errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user pendingConnections pagination query)
|
||||
toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
|
||||
pure $ CRApiChats user previews
|
||||
APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
|
||||
-- TODO optimize queries calculating ChatStats, currently they're disabled
|
||||
CTDirect -> do
|
||||
|
|
@ -1048,10 +1050,12 @@ processChatCommand = \case
|
|||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
|
||||
APIAcceptContact incognito connReqId -> withUser $ \_ -> withChatLock "acceptContact" $ do
|
||||
(user, cReq) <- withStore $ \db -> getContactRequest' db connReqId
|
||||
(user@User {userId}, cReq@UserContactRequest {userContactLinkId}) <- withStore $ \db -> getContactRequest' db connReqId
|
||||
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
|
||||
let contactUsed = (\(_, groupId_, _) -> isNothing groupId_) ucl
|
||||
-- [incognito] generate profile to send, create connection with incognito profile
|
||||
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
|
||||
ct <- acceptContactRequest user cReq incognitoProfile
|
||||
ct <- acceptContactRequest user cReq incognitoProfile contactUsed
|
||||
pure $ CRAcceptingContactRequest user ct
|
||||
APIRejectContact connReqId -> withUser $ \user -> withChatLock "rejectContact" $ do
|
||||
cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <-
|
||||
|
|
@ -1824,8 +1828,10 @@ processChatCommand = \case
|
|||
let mc = MCText msg
|
||||
processChatCommand . APISendMessage (ChatRef CTGroup groupId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
LastChats count_ -> withUser' $ \user -> do
|
||||
chats <- withStore' $ \db -> getChatPreviews db user False
|
||||
pure $ CRChats $ maybe id take count_ chats
|
||||
let count = fromMaybe 5000 count_
|
||||
(errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user False (PTLast count) clqNoFilters)
|
||||
toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
|
||||
pure $ CRChats previews
|
||||
LastMessages (Just chatName) count search -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
chatResp <- processChatCommand $ APIGetChat chatRef (CPLast count) search
|
||||
|
|
@ -2691,21 +2697,21 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
|
|||
getTmpHandle :: FilePath -> m Handle
|
||||
getTmpHandle fPath = openFile fPath AppendMode `catchThrow` (ChatError . CEFileInternal . show)
|
||||
|
||||
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
|
||||
acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile = do
|
||||
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> m Contact
|
||||
acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile contactUsed = do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let profileToSend = profileToSendOnAccept user incognitoProfile
|
||||
dm <- directMessage $ XInfo profileToSend
|
||||
acId <- withAgent $ \a -> acceptContact a True invId dm subMode
|
||||
withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode
|
||||
withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode contactUsed
|
||||
|
||||
acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
|
||||
acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
|
||||
acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> m Contact
|
||||
acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed = do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let profileToSend = profileToSendOnAccept user incognitoProfile
|
||||
(cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode
|
||||
withStore' $ \db -> do
|
||||
ct@Contact {activeConn} <- createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId p userContactLinkId xContactId incognitoProfile subMode
|
||||
ct@Contact {activeConn} <- createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId p userContactLinkId xContactId incognitoProfile subMode contactUsed
|
||||
forM_ activeConn $ \Connection {connId} -> setCommandConnId db user cmdId connId
|
||||
pure ct
|
||||
|
||||
|
|
@ -3384,20 +3390,20 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
doProbeContacts = isJust groupLinkId
|
||||
probeMatchingContactsAndMembers ct (contactConnIncognito ct) doProbeContacts
|
||||
withStore' $ \db -> resetContactConnInitiated db user conn
|
||||
forM_ viaUserContactLink $ \userContactLinkId ->
|
||||
withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
|
||||
Just (UserContactLink {autoAccept = Just AutoAccept {autoReply = mc_}}, groupId_, gLinkMemRole) -> do
|
||||
forM_ mc_ $ \mc -> do
|
||||
(msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
|
||||
toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
|
||||
forM_ groupId_ $ \groupId -> do
|
||||
groupInfo <- withStore $ \db -> getGroupInfo db user groupId
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
|
||||
gVar <- asks idsDrg
|
||||
withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode
|
||||
_ -> pure ()
|
||||
forM_ viaUserContactLink $ \userContactLinkId -> do
|
||||
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
|
||||
let (UserContactLink {autoAccept}, groupId_, gLinkMemRole) = ucl
|
||||
forM_ autoAccept $ \(AutoAccept {autoReply = mc_}) ->
|
||||
forM_ mc_ $ \mc -> do
|
||||
(msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
|
||||
toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
|
||||
forM_ groupId_ $ \groupId -> do
|
||||
groupInfo <- withStore $ \db -> getGroupInfo db user groupId
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
|
||||
gVar <- asks idsDrg
|
||||
withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode
|
||||
Just (gInfo, m@GroupMember {activeConn}) ->
|
||||
when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
|
||||
notifyMemberConnected gInfo m $ Just ct
|
||||
|
|
@ -3915,28 +3921,27 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId chatVRange p xContactId_) >>= \case
|
||||
CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact
|
||||
CORRequest cReq -> do
|
||||
withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
|
||||
Just (UserContactLink {autoAccept}, groupId_, gLinkMemRole) ->
|
||||
case autoAccept of
|
||||
Just AutoAccept {acceptIncognito} -> case groupId_ of
|
||||
Nothing -> do
|
||||
-- [incognito] generate profile to send, create connection with incognito profile
|
||||
incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
|
||||
ct <- acceptContactRequestAsync user cReq incognitoProfile
|
||||
toView $ CRAcceptingContactRequest user ct
|
||||
Just groupId -> do
|
||||
gInfo <- withStore $ \db -> getGroupInfo db user groupId
|
||||
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
||||
if isCompatibleRange chatVRange groupLinkNoContactVRange
|
||||
then do
|
||||
mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode
|
||||
createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||
toView $ CRAcceptingGroupJoinRequestMember user gInfo mem
|
||||
else do
|
||||
ct <- acceptContactRequestAsync user cReq profileMode
|
||||
toView $ CRAcceptingGroupJoinRequest user gInfo ct
|
||||
_ -> toView $ CRReceivedContactRequest user cReq
|
||||
_ -> pure ()
|
||||
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
|
||||
let (UserContactLink {autoAccept}, groupId_, gLinkMemRole) = ucl
|
||||
case autoAccept of
|
||||
Just AutoAccept {acceptIncognito} -> case groupId_ of
|
||||
Nothing -> do
|
||||
-- [incognito] generate profile to send, create connection with incognito profile
|
||||
incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
|
||||
ct <- acceptContactRequestAsync user cReq incognitoProfile True
|
||||
toView $ CRAcceptingContactRequest user ct
|
||||
Just groupId -> do
|
||||
gInfo <- withStore $ \db -> getGroupInfo db user groupId
|
||||
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
||||
if isCompatibleRange chatVRange groupLinkNoContactVRange
|
||||
then do
|
||||
mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode
|
||||
createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||
toView $ CRAcceptingGroupJoinRequestMember user gInfo mem
|
||||
else do
|
||||
ct <- acceptContactRequestAsync user cReq profileMode False
|
||||
toView $ CRAcceptingGroupJoinRequest user gInfo ct
|
||||
_ -> toView $ CRReceivedContactRequest user cReq
|
||||
|
||||
memberCanSend :: GroupMember -> m () -> m ()
|
||||
memberCanSend mem a
|
||||
|
|
@ -4932,7 +4937,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
conn' <- updatePeerChatVRange activeConn chatVRange
|
||||
case chatMsgEvent of
|
||||
XInfo p -> do
|
||||
ct <- withStore $ \db -> createDirectContact db user conn' p
|
||||
let contactUsed = connDirect activeConn
|
||||
ct <- withStore $ \db -> createDirectContact db user conn' p contactUsed
|
||||
toView $ CRContactConnecting user ct
|
||||
pure conn'
|
||||
XGrpLinkInv glInv -> do
|
||||
|
|
@ -5982,7 +5988,13 @@ chatCommandP =
|
|||
"/sql chat " *> (ExecChatStoreSQL <$> textP),
|
||||
"/sql agent " *> (ExecAgentStoreSQL <$> textP),
|
||||
"/sql slow" $> SlowSQLQueries,
|
||||
"/_get chats " *> (APIGetChats <$> A.decimal <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)),
|
||||
"/_get chats "
|
||||
*> ( APIGetChats
|
||||
<$> A.decimal
|
||||
<*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)
|
||||
<*> (A.space *> paginationByTimeP <|> pure (PTLast 5000))
|
||||
<*> (A.space *> jsonP <|> pure clqNoFilters)
|
||||
),
|
||||
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
|
||||
"/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
|
||||
"/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal),
|
||||
|
|
@ -6222,6 +6234,10 @@ chatCommandP =
|
|||
(CPLast <$ "count=" <*> A.decimal)
|
||||
<|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
|
||||
<|> (CPBefore <$ "before=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
|
||||
paginationByTimeP =
|
||||
(PTLast <$ "count=" <*> A.decimal)
|
||||
<|> (PTAfter <$ "after=" <*> strP <* A.space <* "count=" <*> A.decimal)
|
||||
<|> (PTBefore <$ "before=" <*> strP <* A.space <* "count=" <*> A.decimal)
|
||||
mcTextP = MCText . safeDecodeUtf8 <$> A.takeByteString
|
||||
msgContentP = "text " *> mcTextP <|> "json " *> jsonP
|
||||
ciDeleteMode = "broadcast" $> CIDMBroadcast <|> "internal" $> CIDMInternal
|
||||
|
|
|
|||
|
|
@ -247,7 +247,7 @@ data ChatCommand
|
|||
| ExecChatStoreSQL Text
|
||||
| ExecAgentStoreSQL Text
|
||||
| SlowSQLQueries
|
||||
| APIGetChats {userId :: UserId, pendingConnections :: Bool}
|
||||
| APIGetChats {userId :: UserId, pendingConnections :: Bool, pagination :: PaginationByTime, query :: ChatListQuery}
|
||||
| APIGetChat ChatRef ChatPagination (Maybe String)
|
||||
| APIGetChatItems ChatPagination (Maybe String)
|
||||
| APIGetChatItemInfo ChatRef ChatItemId
|
||||
|
|
@ -685,6 +685,7 @@ data ChatResponse
|
|||
| CRMessageError {user :: User, severity :: Text, errorMessage :: Text}
|
||||
| CRChatCmdError {user_ :: Maybe User, chatError :: ChatError}
|
||||
| CRChatError {user_ :: Maybe User, chatError :: ChatError}
|
||||
| CRChatErrors {user_ :: Maybe User, chatErrors :: [ChatError]}
|
||||
| CRArchiveImported {archiveErrors :: [ArchiveError]}
|
||||
| CRTimedAction {action :: String, durationMilliseconds :: Int64}
|
||||
deriving (Show)
|
||||
|
|
@ -733,6 +734,26 @@ logResponseToFile = \case
|
|||
CRMessageError {} -> True
|
||||
_ -> False
|
||||
|
||||
data ChatPagination
|
||||
= CPLast Int
|
||||
| CPAfter ChatItemId Int
|
||||
| CPBefore ChatItemId Int
|
||||
deriving (Show)
|
||||
|
||||
data PaginationByTime
|
||||
= PTLast Int
|
||||
| PTAfter UTCTime Int
|
||||
| PTBefore UTCTime Int
|
||||
deriving (Show)
|
||||
|
||||
data ChatListQuery
|
||||
= CLQFilters {favorite :: Bool, unread :: Bool}
|
||||
| CLQSearch {search :: String}
|
||||
deriving (Show)
|
||||
|
||||
clqNoFilters :: ChatListQuery
|
||||
clqNoFilters = CLQFilters {favorite = False, unread = False}
|
||||
|
||||
data ConnectionPlan
|
||||
= CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan}
|
||||
| CPContactAddress {contactAddressPlan :: ContactAddressPlan}
|
||||
|
|
@ -1266,6 +1287,8 @@ withAgent action =
|
|||
|
||||
$(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CLQ") ''ChatListQuery)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "ILP") ''InvitationLinkPlan)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CAP") ''ContactAddressPlan)
|
||||
|
|
|
|||
|
|
@ -713,12 +713,6 @@ type ChatItemId = Int64
|
|||
|
||||
type ChatItemTs = UTCTime
|
||||
|
||||
data ChatPagination
|
||||
= CPLast Int
|
||||
| CPAfter ChatItemId Int
|
||||
| CPBefore ChatItemId Int
|
||||
deriving (Show)
|
||||
|
||||
data SChatType (c :: ChatType) where
|
||||
SCTDirect :: SChatType 'CTDirect
|
||||
SCTGroup :: SChatType 'CTGroup
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ import Database.SQLite.Simple.QQ (sql)
|
|||
m20221222_chat_ts :: Query
|
||||
m20221222_chat_ts =
|
||||
[sql|
|
||||
ALTER TABLE contacts ADD COLUMN chat_ts TEXT;
|
||||
ALTER TABLE contacts ADD COLUMN chat_ts TEXT; -- must be not NULL
|
||||
|
||||
ALTER TABLE groups ADD COLUMN chat_ts TEXT;
|
||||
ALTER TABLE groups ADD COLUMN chat_ts TEXT; -- must be not NULL
|
||||
|]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,44 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20231207_chat_list_pagination where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20231207_chat_list_pagination :: Query
|
||||
m20231207_chat_list_pagination =
|
||||
[sql|
|
||||
UPDATE contacts SET contact_used = 1
|
||||
WHERE contact_id = (
|
||||
SELECT contact_id FROM connections
|
||||
WHERE conn_level = 0 AND via_group_link = 0
|
||||
);
|
||||
|
||||
UPDATE contacts
|
||||
SET chat_ts = updated_at
|
||||
WHERE chat_ts IS NULL;
|
||||
|
||||
UPDATE groups
|
||||
SET chat_ts = updated_at
|
||||
WHERE chat_ts IS NULL;
|
||||
|
||||
CREATE INDEX idx_contacts_chat_ts ON contacts(user_id, chat_ts);
|
||||
CREATE INDEX idx_groups_chat_ts ON groups(user_id, chat_ts);
|
||||
CREATE INDEX idx_contact_requests_updated_at ON contact_requests(user_id, updated_at);
|
||||
CREATE INDEX idx_connections_updated_at ON connections(user_id, updated_at);
|
||||
|
||||
CREATE INDEX idx_chat_items_contact_id_item_status ON chat_items(contact_id, item_status);
|
||||
CREATE INDEX idx_chat_items_group_id_item_status ON chat_items(group_id, item_status);
|
||||
|]
|
||||
|
||||
down_m20231207_chat_list_pagination :: Query
|
||||
down_m20231207_chat_list_pagination =
|
||||
[sql|
|
||||
DROP INDEX idx_contacts_chat_ts;
|
||||
DROP INDEX idx_groups_chat_ts;
|
||||
DROP INDEX idx_contact_requests_updated_at;
|
||||
DROP INDEX idx_connections_updated_at;
|
||||
|
||||
DROP INDEX idx_chat_items_contact_id_item_status;
|
||||
DROP INDEX idx_chat_items_group_id_item_status;
|
||||
|]
|
||||
|
|
@ -810,3 +810,18 @@ CREATE UNIQUE INDEX idx_remote_hosts_host_fingerprint ON remote_hosts(
|
|||
CREATE UNIQUE INDEX idx_remote_controllers_ctrl_fingerprint ON remote_controllers(
|
||||
ctrl_fingerprint
|
||||
);
|
||||
CREATE INDEX idx_contacts_chat_ts ON contacts(user_id, chat_ts);
|
||||
CREATE INDEX idx_groups_chat_ts ON groups(user_id, chat_ts);
|
||||
CREATE INDEX idx_contact_requests_updated_at ON contact_requests(
|
||||
user_id,
|
||||
updated_at
|
||||
);
|
||||
CREATE INDEX idx_connections_updated_at ON connections(user_id, updated_at);
|
||||
CREATE INDEX idx_chat_items_contact_id_item_status ON chat_items(
|
||||
contact_id,
|
||||
item_status
|
||||
);
|
||||
CREATE INDEX idx_chat_items_group_id_item_status ON chat_items(
|
||||
group_id,
|
||||
item_status
|
||||
);
|
||||
|
|
|
|||
|
|
@ -201,15 +201,15 @@ createIncognitoProfile db User {userId} p = do
|
|||
createdAt <- getCurrentTime
|
||||
createIncognitoProfile_ db userId createdAt p
|
||||
|
||||
createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
|
||||
createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do
|
||||
createDirectContact :: DB.Connection -> User -> Connection -> Profile -> Bool -> ExceptT StoreError IO Contact
|
||||
createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} contactUsed = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
(localDisplayName, contactId, profileId) <- createContact_ db userId p localAlias Nothing currentTs (Just currentTs)
|
||||
(localDisplayName, contactId, profileId) <- createContact_ db userId p localAlias Nothing currentTs contactUsed
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
|
||||
let profile = toLocalProfile profileId p localAlias
|
||||
userPreferences = emptyChatPrefs
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
|
||||
deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
|
||||
deleteContactConnectionsAndFiles db userId Contact {contactId} = do
|
||||
|
|
@ -650,8 +650,8 @@ deleteContactRequest db User {userId} contactRequestId = do
|
|||
(userId, userId, contactRequestId)
|
||||
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
|
||||
|
||||
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> IO Contact
|
||||
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode = do
|
||||
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> Bool -> IO Contact
|
||||
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode contactUsed = do
|
||||
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
createdAt <- getCurrentTime
|
||||
customUserProfileId <- forM incognitoProfile $ \case
|
||||
|
|
@ -660,12 +660,12 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
|
|||
let userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId)
|
||||
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)"
|
||||
(userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId, contactUsed)
|
||||
contactId <- insertedRowId db
|
||||
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
|
||||
getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
|
||||
getContactIdByName db User {userId} cName =
|
||||
|
|
|
|||
|
|
@ -1149,7 +1149,7 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
|
|||
Just (directCmdId, directAgentConnId) -> do
|
||||
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
|
||||
liftIO $ setCommandConnId db user directCmdId directConnId
|
||||
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs Nothing
|
||||
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Just contactId, memProfileId}
|
||||
Nothing -> do
|
||||
|
|
@ -1178,12 +1178,12 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
|
|||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO contacts (contact_profile_id, via_group, local_display_name, user_id, created_at, updated_at)
|
||||
SELECT contact_profile_id, group_id, ?, ?, ?, ?
|
||||
INSERT INTO contacts (contact_profile_id, via_group, local_display_name, user_id, created_at, updated_at, chat_ts)
|
||||
SELECT contact_profile_id, group_id, ?, ?, ?, ?, ?
|
||||
FROM group_members
|
||||
WHERE group_member_id = ?
|
||||
|]
|
||||
(localDisplayName, userId, ts, ts, groupMemberId)
|
||||
(localDisplayName, userId, ts, ts, ts, groupMemberId)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, ts, connId)
|
||||
pure contactId
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
|
@ -109,14 +110,15 @@ import Data.Bifunctor (first)
|
|||
import Data.ByteString.Char8 (ByteString)
|
||||
import Data.Either (fromRight, rights)
|
||||
import Data.Int (Int64)
|
||||
import Data.List (sortOn)
|
||||
import Data.List (sortBy)
|
||||
import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||
import Data.Ord (Down (..))
|
||||
import Data.Ord (Down (..), comparing)
|
||||
import Data.Text (Text)
|
||||
import Data.Time (addUTCTime)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Database.SQLite.Simple (NamedParam (..), Only (..), (:.) (..))
|
||||
import Database.SQLite.Simple (NamedParam (..), Only (..), Query, (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Simplex.Chat.Controller (ChatListQuery (..), ChatPagination (..), PaginationByTime (..))
|
||||
import Simplex.Chat.Markdown
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
|
|
@ -467,7 +469,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
|
|||
<$> DB.queryNamed
|
||||
db
|
||||
[sql|
|
||||
SELECT i.chat_item_id,
|
||||
SELECT i.chat_item_id,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
|
|
@ -486,209 +488,402 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
|
|||
ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
|
||||
ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow
|
||||
|
||||
getChatPreviews :: DB.Connection -> User -> Bool -> IO [AChat]
|
||||
getChatPreviews db user withPCC = do
|
||||
directChats <- getDirectChatPreviews_ db user
|
||||
groupChats <- getGroupChatPreviews_ db user
|
||||
cReqChats <- getContactRequestChatPreviews_ db user
|
||||
connChats <- getContactConnectionChatPreviews_ db user withPCC
|
||||
pure $ sortOn (Down . ts) (directChats <> groupChats <> cReqChats <> connChats)
|
||||
getChatPreviews :: DB.Connection -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
|
||||
getChatPreviews db user withPCC pagination query = do
|
||||
directChats <- findDirectChatPreviews_ db user pagination query
|
||||
groupChats <- findGroupChatPreviews_ db user pagination query
|
||||
cReqChats <- getContactRequestChatPreviews_ db user pagination query
|
||||
connChats <- if withPCC then getContactConnectionChatPreviews_ db user pagination query else pure []
|
||||
let refs = sortTake $ concat [directChats, groupChats, cReqChats, connChats]
|
||||
mapM (runExceptT <$> getChatPreview) refs
|
||||
where
|
||||
ts :: AChat -> UTCTime
|
||||
ts (AChat _ Chat {chatInfo, chatItems}) = case chatInfoChatTs chatInfo of
|
||||
Just chatTs -> chatTs
|
||||
Nothing -> case chatItems of
|
||||
ci : _ -> max (chatItemTs ci) (chatInfoUpdatedAt chatInfo)
|
||||
_ -> chatInfoUpdatedAt chatInfo
|
||||
ts :: AChatPreviewData -> UTCTime
|
||||
ts (ACPD _ cpd) = case cpd of
|
||||
(DirectChatPD t _ _) -> t
|
||||
(GroupChatPD t _ _) -> t
|
||||
(ContactRequestPD t _) -> t
|
||||
(ContactConnectionPD t _) -> t
|
||||
sortTake = case pagination of
|
||||
PTLast count -> take count . sortBy (comparing $ Down . ts)
|
||||
PTAfter _ count -> reverse . take count . sortBy (comparing ts)
|
||||
PTBefore _ count -> take count . sortBy (comparing $ Down . ts)
|
||||
getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat
|
||||
getChatPreview (ACPD cType cpd) = case cType of
|
||||
SCTDirect -> getDirectChatPreview_ db user cpd
|
||||
SCTGroup -> getGroupChatPreview_ db user cpd
|
||||
SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat
|
||||
SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat
|
||||
|
||||
getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChat]
|
||||
getDirectChatPreviews_ db user@User {userId} = do
|
||||
currentTs <- getCurrentTime
|
||||
map (toDirectChatPreview currentTs)
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
-- ChatStats
|
||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat,
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
LEFT JOIN connections c ON c.contact_id = ct.contact_id
|
||||
LEFT JOIN (
|
||||
SELECT contact_id, chat_item_id, MAX(created_at)
|
||||
FROM chat_items
|
||||
GROUP BY contact_id
|
||||
) LastItems ON LastItems.contact_id = ct.contact_id
|
||||
LEFT JOIN chat_items i ON i.contact_id = LastItems.contact_id
|
||||
AND i.chat_item_id = LastItems.chat_item_id
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
LEFT JOIN (
|
||||
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE item_status = ?
|
||||
GROUP BY contact_id
|
||||
) ChatStats ON ChatStats.contact_id = ct.contact_id
|
||||
LEFT JOIN chat_items ri ON ri.user_id = i.user_id AND ri.contact_id = i.contact_id AND ri.shared_msg_id = i.quoted_shared_msg_id
|
||||
WHERE ct.user_id = ?
|
||||
AND ct.is_user = 0
|
||||
AND ct.deleted = 0
|
||||
AND (
|
||||
(
|
||||
((c.conn_level = 0 AND c.via_group_link = 0) OR ct.contact_used = 1)
|
||||
AND c.connection_id = (
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
)
|
||||
)
|
||||
)
|
||||
OR c.connection_id IS NULL
|
||||
data ChatPreviewData (c :: ChatType) where
|
||||
DirectChatPD :: UTCTime -> ContactId -> Maybe ChatStats -> ChatPreviewData 'CTDirect
|
||||
GroupChatPD :: UTCTime -> GroupId -> Maybe ChatStats -> ChatPreviewData 'CTGroup
|
||||
ContactRequestPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactRequest
|
||||
ContactConnectionPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactConnection
|
||||
|
||||
data AChatPreviewData = forall c. ChatTypeI c => ACPD (SChatType c) (ChatPreviewData c)
|
||||
|
||||
paginationByTimeFilter :: PaginationByTime -> (Query, [NamedParam])
|
||||
paginationByTimeFilter = \case
|
||||
PTLast count -> ("\nORDER BY ts DESC LIMIT :count", [":count" := count])
|
||||
PTAfter ts count -> ("\nAND ts > :ts ORDER BY ts ASC LIMIT :count", [":ts" := ts, ":count" := count])
|
||||
PTBefore ts count -> ("\nAND ts < :ts ORDER BY ts DESC LIMIT :count", [":ts" := ts, ":count" := count])
|
||||
|
||||
type MaybeChatStatsRow = (Maybe Int, Maybe ChatItemId, Maybe Bool)
|
||||
|
||||
toMaybeChatStats :: MaybeChatStatsRow -> Maybe ChatStats
|
||||
toMaybeChatStats (Just unreadCount, Just minUnreadItemId, Just unreadChat) = Just ChatStats {unreadCount, minUnreadItemId, unreadChat}
|
||||
toMaybeChatStats _ = Nothing
|
||||
|
||||
findDirectChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
|
||||
findDirectChatPreviews_ db User {userId} pagination clq =
|
||||
map toPreview <$> getPreviews
|
||||
where
|
||||
toPreview :: (ContactId, UTCTime) :. MaybeChatStatsRow -> AChatPreviewData
|
||||
toPreview ((contactId, ts) :. statsRow_) =
|
||||
ACPD SCTDirect $ DirectChatPD ts contactId (toMaybeChatStats statsRow_)
|
||||
(pagQuery, pagParams) = paginationByTimeFilter pagination
|
||||
getPreviews = case clq of
|
||||
CLQFilters {favorite = False, unread = False} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT ct.contact_id, ct.chat_ts as ts, NULL, NULL, NULL
|
||||
FROM contacts ct
|
||||
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
ORDER BY i.item_ts DESC
|
||||
|]
|
||||
(CISRcvNew, userId, ConnReady, ConnSndReady)
|
||||
where
|
||||
toDirectChatPreview :: UTCTime -> ContactRow :. MaybeConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat
|
||||
toDirectChatPreview currentTs (contactRow :. connRow :. statsRow :. ciRow_) =
|
||||
let contact = toContact user $ contactRow :. connRow
|
||||
ci_ = toDirectChatItemList currentTs ciRow_
|
||||
stats = toChatStats statsRow
|
||||
in AChat SCTDirect $ Chat (DirectChat contact) ci_ stats
|
||||
([":user_id" := userId] <> pagParams)
|
||||
CLQFilters {favorite = True, unread = False} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT ct.contact_id, ct.chat_ts as ts, NULL, NULL, NULL
|
||||
FROM contacts ct
|
||||
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
|
||||
AND ct.favorite = 1
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId] <> pagParams)
|
||||
CLQFilters {favorite = False, unread = True} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT ct.contact_id, ct.chat_ts as ts, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat
|
||||
FROM contacts ct
|
||||
LEFT JOIN (
|
||||
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE item_status = :rcv_new
|
||||
GROUP BY contact_id
|
||||
) ChatStats ON ChatStats.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
|
||||
AND (ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
|
||||
CLQFilters {favorite = True, unread = True} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT ct.contact_id, ct.chat_ts as ts, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat
|
||||
FROM contacts ct
|
||||
LEFT JOIN (
|
||||
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE item_status = :rcv_new
|
||||
GROUP BY contact_id
|
||||
) ChatStats ON ChatStats.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
|
||||
AND (ct.favorite = 1
|
||||
OR ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
|
||||
CLQSearch {search} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT ct.contact_id, ct.chat_ts as ts, NULL, NULL, NULL
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
|
||||
AND (
|
||||
ct.local_display_name LIKE '%' || :search || '%'
|
||||
OR cp.display_name LIKE '%' || :search || '%'
|
||||
OR cp.full_name LIKE '%' || :search || '%'
|
||||
OR cp.local_alias LIKE '%' || :search || '%'
|
||||
)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":search" := search] <> pagParams)
|
||||
|
||||
getGroupChatPreviews_ :: DB.Connection -> User -> IO [AChat]
|
||||
getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
currentTs <- getCurrentTime
|
||||
map (toGroupChatPreview currentTs)
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
|
||||
-- ChatStats
|
||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat,
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- CIMeta forwardedByMember
|
||||
i.forwarded_by_group_member_id,
|
||||
-- Maybe GroupMember - sender
|
||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
-- quoted ChatItem
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
|
||||
-- quoted GroupMember
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.show_messages, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
|
||||
-- deleted by GroupMember
|
||||
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
|
||||
FROM groups g
|
||||
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
|
||||
JOIN group_members mu ON mu.group_id = g.group_id
|
||||
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
|
||||
LEFT JOIN (
|
||||
SELECT group_id, chat_item_id, MAX(item_ts)
|
||||
FROM chat_items
|
||||
GROUP BY group_id
|
||||
) LastItems ON LastItems.group_id = g.group_id
|
||||
LEFT JOIN chat_items i ON i.group_id = LastItems.group_id
|
||||
AND i.chat_item_id = LastItems.chat_item_id
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE item_status = ?
|
||||
GROUP BY group_id
|
||||
) ChatStats ON ChatStats.group_id = g.group_id
|
||||
LEFT JOIN group_members m ON m.group_member_id = i.group_member_id
|
||||
LEFT JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN chat_items ri ON ri.shared_msg_id = i.quoted_shared_msg_id AND ri.group_id = i.group_id
|
||||
LEFT JOIN group_members rm ON rm.group_member_id = ri.group_member_id
|
||||
LEFT JOIN contact_profiles rp ON rp.contact_profile_id = COALESCE(rm.member_profile_id, rm.contact_profile_id)
|
||||
LEFT JOIN group_members dbm ON dbm.group_member_id = i.item_deleted_by_group_member_id
|
||||
LEFT JOIN contact_profiles dbp ON dbp.contact_profile_id = COALESCE(dbm.member_profile_id, dbm.contact_profile_id)
|
||||
WHERE g.user_id = ? AND mu.contact_id = ?
|
||||
ORDER BY i.item_ts DESC
|
||||
|]
|
||||
(CISRcvNew, userId, userContactId)
|
||||
getDirectChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
|
||||
getDirectChatPreview_ db user (DirectChatPD _ contactId stats_) = do
|
||||
contact <- getContact db user contactId
|
||||
lastItem <- getLastItem
|
||||
stats <- maybe getChatStats pure stats_
|
||||
pure $ AChat SCTDirect (Chat (DirectChat contact) lastItem stats)
|
||||
where
|
||||
toGroupChatPreview :: UTCTime -> GroupInfoRow :. ChatStatsRow :. MaybeGroupChatItemRow -> AChat
|
||||
toGroupChatPreview currentTs (groupInfoRow :. statsRow :. ciRow_) =
|
||||
let groupInfo = toGroupInfo userContactId groupInfoRow
|
||||
ci_ = toGroupChatItemList currentTs userContactId ciRow_
|
||||
stats = toChatStats statsRow
|
||||
in AChat SCTGroup $ Chat (GroupChat groupInfo) ci_ stats
|
||||
getLastItem :: ExceptT StoreError IO [CChatItem 'CTDirect]
|
||||
getLastItem =
|
||||
liftIO getLastItemId >>= \case
|
||||
Nothing -> pure []
|
||||
Just lastItemId -> (: []) <$> getDirectChatItem db user contactId lastItemId
|
||||
getLastItemId :: IO (Maybe ChatItemId)
|
||||
getLastItemId =
|
||||
maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id FROM (
|
||||
SELECT contact_id, chat_item_id, MAX(created_at)
|
||||
FROM chat_items
|
||||
WHERE contact_id = ?
|
||||
GROUP BY contact_id
|
||||
)
|
||||
|]
|
||||
(Only contactId)
|
||||
getChatStats :: ExceptT StoreError IO ChatStats
|
||||
getChatStats = do
|
||||
r_ <- liftIO getUnreadStats
|
||||
let (unreadCount, minUnreadItemId) = maybe (0, 0) (\(_, unreadCnt, minId) -> (unreadCnt, minId)) r_
|
||||
-- unread_chat could be read into contact to not search twice
|
||||
unreadChat <-
|
||||
ExceptT . firstRow fromOnly (SEInternalError $ "unread_chat not found for contact " <> show contactId) $
|
||||
DB.query db "SELECT unread_chat FROM contacts WHERE contact_id = ?" (Only contactId)
|
||||
pure ChatStats {unreadCount, minUnreadItemId, unreadChat}
|
||||
getUnreadStats :: IO (Maybe (ContactId, Int, ChatItemId))
|
||||
getUnreadStats =
|
||||
maybeFirstRow id $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE contact_id = ? AND item_status = ?
|
||||
GROUP BY contact_id
|
||||
|]
|
||||
(contactId, CISRcvNew)
|
||||
|
||||
getContactRequestChatPreviews_ :: DB.Connection -> User -> IO [AChat]
|
||||
getContactRequestChatPreviews_ db User {userId} =
|
||||
map toContactRequestChatPreview
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at,
|
||||
cr.peer_chat_min_version, cr.peer_chat_max_version
|
||||
FROM contact_requests cr
|
||||
JOIN connections c ON c.user_contact_link_id = cr.user_contact_link_id
|
||||
JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id
|
||||
JOIN user_contact_links uc ON uc.user_contact_link_id = cr.user_contact_link_id
|
||||
WHERE cr.user_id = ? AND uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL
|
||||
|]
|
||||
(userId, userId)
|
||||
findGroupChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
|
||||
findGroupChatPreviews_ db User {userId} pagination clq =
|
||||
map toPreview <$> getPreviews
|
||||
where
|
||||
toContactRequestChatPreview :: ContactRequestRow -> AChat
|
||||
toContactRequestChatPreview cReqRow =
|
||||
let cReq = toContactRequest cReqRow
|
||||
toPreview :: (GroupId, UTCTime) :. MaybeChatStatsRow -> AChatPreviewData
|
||||
toPreview ((groupId, ts) :. statsRow_) =
|
||||
ACPD SCTGroup $ GroupChatPD ts groupId (toMaybeChatStats statsRow_)
|
||||
(pagQuery, pagParams) = paginationByTimeFilter pagination
|
||||
getPreviews = case clq of
|
||||
CLQFilters {favorite = False, unread = False} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT g.group_id, g.chat_ts as ts, NULL, NULL, NULL
|
||||
FROM groups g
|
||||
WHERE g.user_id = :user_id
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId] <> pagParams)
|
||||
CLQFilters {favorite = True, unread = False} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT g.group_id, g.chat_ts as ts, NULL, NULL, NULL
|
||||
FROM groups g
|
||||
WHERE g.user_id = :user_id
|
||||
AND g.favorite = 1
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId] <> pagParams)
|
||||
CLQFilters {favorite = False, unread = True} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT g.group_id, g.chat_ts as ts, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE item_status = :rcv_new
|
||||
GROUP BY group_id
|
||||
) ChatStats ON ChatStats.group_id = g.group_id
|
||||
WHERE g.user_id = :user_id
|
||||
AND (g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
|
||||
CLQFilters {favorite = True, unread = True} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT g.group_id, g.chat_ts as ts, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE item_status = :rcv_new
|
||||
GROUP BY group_id
|
||||
) ChatStats ON ChatStats.group_id = g.group_id
|
||||
WHERE g.user_id = :user_id
|
||||
AND (g.favorite = 1
|
||||
OR g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
|
||||
CLQSearch {search} ->
|
||||
DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT g.group_id, g.chat_ts as ts, NULL, NULL, NULL
|
||||
FROM groups g
|
||||
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
|
||||
WHERE g.user_id = :user_id
|
||||
AND (
|
||||
g.local_display_name LIKE '%' || :search || '%'
|
||||
OR gp.display_name LIKE '%' || :search || '%'
|
||||
OR gp.full_name LIKE '%' || :search || '%'
|
||||
OR gp.description LIKE '%' || :search || '%'
|
||||
)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":search" := search] <> pagParams)
|
||||
|
||||
getGroupChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
|
||||
getGroupChatPreview_ db user (GroupChatPD _ groupId stats_) = do
|
||||
groupInfo <- getGroupInfo db user groupId
|
||||
lastItem <- getLastItem
|
||||
stats <- maybe getChatStats pure stats_
|
||||
pure $ AChat SCTGroup (Chat (GroupChat groupInfo) lastItem stats)
|
||||
where
|
||||
getLastItem :: ExceptT StoreError IO [CChatItem 'CTGroup]
|
||||
getLastItem =
|
||||
liftIO getLastItemId >>= \case
|
||||
Nothing -> pure []
|
||||
Just lastItemId -> (: []) <$> getGroupChatItem db user groupId lastItemId
|
||||
getLastItemId :: IO (Maybe ChatItemId)
|
||||
getLastItemId =
|
||||
maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id FROM (
|
||||
SELECT group_id, chat_item_id, MAX(item_ts)
|
||||
FROM chat_items
|
||||
WHERE group_id = ?
|
||||
GROUP BY group_id
|
||||
)
|
||||
|]
|
||||
(Only groupId)
|
||||
getChatStats :: ExceptT StoreError IO ChatStats
|
||||
getChatStats = do
|
||||
r_ <- liftIO getUnreadStats
|
||||
let (unreadCount, minUnreadItemId) = maybe (0, 0) (\(_, unreadCnt, minId) -> (unreadCnt, minId)) r_
|
||||
-- unread_chat could be read into group to not search twice
|
||||
unreadChat <-
|
||||
ExceptT . firstRow fromOnly (SEInternalError $ "unread_chat not found for group " <> show groupId) $
|
||||
DB.query db "SELECT unread_chat FROM groups WHERE group_id = ?" (Only groupId)
|
||||
pure ChatStats {unreadCount, minUnreadItemId, unreadChat}
|
||||
getUnreadStats :: IO (Maybe (GroupId, Int, ChatItemId))
|
||||
getUnreadStats =
|
||||
maybeFirstRow id $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE group_id = ? AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|]
|
||||
(groupId, CISRcvNew)
|
||||
|
||||
getContactRequestChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
|
||||
getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
|
||||
CLQFilters {favorite = False, unread = False} -> query ""
|
||||
CLQFilters {favorite = True, unread = False} -> pure []
|
||||
CLQFilters {favorite = False, unread = True} -> query ""
|
||||
CLQFilters {favorite = True, unread = True} -> query ""
|
||||
CLQSearch {search} -> query search
|
||||
where
|
||||
(pagQuery, pagParams) = paginationByTimeFilter pagination
|
||||
query search =
|
||||
map toPreview
|
||||
<$> DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences,
|
||||
cr.created_at, cr.updated_at as ts,
|
||||
cr.peer_chat_min_version, cr.peer_chat_max_version
|
||||
FROM contact_requests cr
|
||||
JOIN connections c ON c.user_contact_link_id = cr.user_contact_link_id
|
||||
JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id
|
||||
JOIN user_contact_links uc ON uc.user_contact_link_id = cr.user_contact_link_id
|
||||
WHERE cr.user_id = :user_id
|
||||
AND uc.user_id = :user_id
|
||||
AND uc.local_display_name = ''
|
||||
AND uc.group_id IS NULL
|
||||
AND (
|
||||
cr.local_display_name LIKE '%' || :search || '%'
|
||||
OR p.display_name LIKE '%' || :search || '%'
|
||||
OR p.full_name LIKE '%' || :search || '%'
|
||||
)
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":search" := search] <> pagParams)
|
||||
toPreview :: ContactRequestRow -> AChatPreviewData
|
||||
toPreview cReqRow =
|
||||
let cReq@UserContactRequest {updatedAt} = toContactRequest cReqRow
|
||||
stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
in AChat SCTContactRequest $ Chat (ContactRequest cReq) [] stats
|
||||
aChat = AChat SCTContactRequest $ Chat (ContactRequest cReq) [] stats
|
||||
in ACPD SCTContactRequest $ ContactRequestPD updatedAt aChat
|
||||
|
||||
getContactConnectionChatPreviews_ :: DB.Connection -> User -> Bool -> IO [AChat]
|
||||
getContactConnectionChatPreviews_ _ _ False = pure []
|
||||
getContactConnectionChatPreviews_ db User {userId} _ =
|
||||
map toContactConnectionChatPreview
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id, custom_user_profile_id, conn_req_inv, local_alias, created_at, updated_at
|
||||
FROM connections
|
||||
WHERE user_id = ? AND conn_type = ? AND contact_id IS NULL AND conn_level = 0 AND via_contact IS NULL AND (via_group_link = 0 || (via_group_link = 1 AND group_link_id IS NOT NULL))
|
||||
|]
|
||||
(userId, ConnContact)
|
||||
getContactConnectionChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
|
||||
getContactConnectionChatPreviews_ db User {userId} pagination clq = case clq of
|
||||
CLQFilters {favorite = False, unread = False} -> query ""
|
||||
CLQFilters {favorite = True, unread = False} -> pure []
|
||||
CLQFilters {favorite = False, unread = True} -> pure []
|
||||
CLQFilters {favorite = True, unread = True} -> pure []
|
||||
CLQSearch {search} -> query search
|
||||
where
|
||||
toContactConnectionChatPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation, LocalAlias, UTCTime, UTCTime) -> AChat
|
||||
toContactConnectionChatPreview connRow =
|
||||
let conn = toPendingContactConnection connRow
|
||||
(pagQuery, pagParams) = paginationByTimeFilter pagination
|
||||
query search =
|
||||
map toPreview
|
||||
<$> DB.queryNamed
|
||||
db
|
||||
( [sql|
|
||||
SELECT
|
||||
connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id,
|
||||
custom_user_profile_id, conn_req_inv, local_alias, created_at, updated_at as ts
|
||||
FROM connections
|
||||
WHERE user_id = :user_id
|
||||
AND conn_type = :conn_contact
|
||||
AND contact_id IS NULL
|
||||
AND conn_level = 0
|
||||
AND via_contact IS NULL
|
||||
AND (via_group_link = 0 || (via_group_link = 1 AND group_link_id IS NOT NULL))
|
||||
AND local_alias LIKE '%' || :search || '%'
|
||||
|]
|
||||
<> pagQuery
|
||||
)
|
||||
([":user_id" := userId, ":conn_contact" := ConnContact, ":search" := search] <> pagParams)
|
||||
toPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation, LocalAlias, UTCTime, UTCTime) -> AChatPreviewData
|
||||
toPreview connRow =
|
||||
let conn@PendingContactConnection {updatedAt} = toPendingContactConnection connRow
|
||||
stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
in AChat SCTContactConnection $ Chat (ContactConnection conn) [] stats
|
||||
aChat = AChat SCTContactConnection $ Chat (ContactConnection conn) [] stats
|
||||
in ACPD SCTContactConnection $ ContactConnectionPD updatedAt aChat
|
||||
|
||||
getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect)
|
||||
getDirectChat db user contactId pagination search_ = do
|
||||
|
|
@ -993,19 +1188,12 @@ setGroupChatItemDeleteAt db User {userId} groupId chatItemId deleteAt =
|
|||
"UPDATE chat_items SET timed_delete_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?"
|
||||
(deleteAt, userId, groupId, chatItemId)
|
||||
|
||||
type ChatStatsRow = (Int, ChatItemId, Bool)
|
||||
|
||||
toChatStats :: ChatStatsRow -> ChatStats
|
||||
toChatStats (unreadCount, minUnreadItemId, unreadChat) = ChatStats {unreadCount, minUnreadItemId, unreadChat}
|
||||
|
||||
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe ACIFileStatus, Maybe FileProtocol)
|
||||
|
||||
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool)
|
||||
|
||||
type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId) :. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
|
||||
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe AMsgDirection, Maybe Text, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId) :. (Maybe Int, Maybe UTCTime, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
|
||||
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
|
||||
|
||||
toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect)
|
||||
|
|
@ -1055,15 +1243,8 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
|||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toDirectChatItemList :: UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect]
|
||||
toDirectChatItemList currentTs (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList _ _ = []
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
|
||||
type MaybeGroupChatItemRow = MaybeChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow
|
||||
|
||||
toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
|
||||
toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_
|
||||
where
|
||||
|
|
@ -1114,11 +1295,6 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
|||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
||||
toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||
toGroupChatItemList _ _ _ = []
|
||||
|
||||
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
|
||||
getAllChatItems db user@User {userId} pagination search_ = do
|
||||
itemRefs <-
|
||||
|
|
|
|||
|
|
@ -91,6 +91,7 @@ import Simplex.Chat.Migrations.M20231107_indexes
|
|||
import Simplex.Chat.Migrations.M20231113_group_forward
|
||||
import Simplex.Chat.Migrations.M20231114_remote_control
|
||||
import Simplex.Chat.Migrations.M20231126_remote_ctrl_address
|
||||
import Simplex.Chat.Migrations.M20231207_chat_list_pagination
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
|
|
@ -181,7 +182,8 @@ schemaMigrations =
|
|||
("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes),
|
||||
("20231113_group_forward", m20231113_group_forward, Just down_m20231113_group_forward),
|
||||
("20231114_remote_control", m20231114_remote_control, Just down_m20231114_remote_control),
|
||||
("20231126_remote_ctrl_address", m20231126_remote_ctrl_address, Just down_m20231126_remote_ctrl_address)
|
||||
("20231126_remote_ctrl_address", m20231126_remote_ctrl_address, Just down_m20231126_remote_ctrl_address),
|
||||
("20231207_chat_list_pagination", m20231207_chat_list_pagination, Just down_m20231207_chat_list_pagination)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
|
|
|||
|
|
@ -116,8 +116,8 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
|
|||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(profileId, displayName, userId, True, currentTs, currentTs)
|
||||
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)"
|
||||
(profileId, displayName, userId, True, currentTs, currentTs, currentTs)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
|
||||
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing)
|
||||
|
|
@ -429,9 +429,9 @@ getUserAddress db User {userId} =
|
|||
|]
|
||||
(Only userId)
|
||||
|
||||
getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> IO (Maybe (UserContactLink, Maybe GroupId, GroupMemberRole))
|
||||
getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO (UserContactLink, Maybe GroupId, GroupMemberRole)
|
||||
getUserContactLinkById db userId userContactLinkId =
|
||||
maybeFirstRow (\(ucl :. (groupId_, mRole_)) -> (toUserContactLink ucl, groupId_, fromMaybe GRMember mRole_)) $
|
||||
ExceptT . firstRow (\(ucl :. (groupId_, mRole_)) -> (toUserContactLink ucl, groupId_, fromMaybe GRMember mRole_)) SEUserContactLinkNotFound $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
|
|
|
|||
|
|
@ -235,10 +235,10 @@ setCommandConnId db User {userId} cmdId connId = do
|
|||
createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO ()
|
||||
createContact db User {userId} profile = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
void $ createContact_ db userId profile "" Nothing currentTs Nothing
|
||||
void $ createContact_ db userId profile "" Nothing currentTs True
|
||||
|
||||
createContact_ :: DB.Connection -> UserId -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> Maybe UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
|
||||
createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs chatTs =
|
||||
createContact_ :: DB.Connection -> UserId -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> Bool -> ExceptT StoreError IO (Text, ContactId, ProfileId)
|
||||
createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs contactUsed =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
DB.execute
|
||||
db
|
||||
|
|
@ -247,8 +247,8 @@ createContact_ db userId Profile {displayName, fullName, image, contactLink, pre
|
|||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)"
|
||||
(profileId, ldn, userId, viaGroup, currentTs, currentTs, chatTs)
|
||||
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, contactUsed)
|
||||
contactId <- insertedRowId db
|
||||
pure $ Right (ldn, contactId, profileId)
|
||||
|
||||
|
|
|
|||
|
|
@ -186,9 +186,10 @@ contactConnIncognito :: Contact -> IncognitoEnabled
|
|||
contactConnIncognito = maybe False connIncognito . contactConn
|
||||
|
||||
contactDirect :: Contact -> Bool
|
||||
contactDirect Contact {activeConn} = maybe True direct activeConn
|
||||
where
|
||||
direct Connection {connLevel, viaGroupLink} = connLevel == 0 && not viaGroupLink
|
||||
contactDirect Contact {activeConn} = maybe True connDirect activeConn
|
||||
|
||||
connDirect :: Connection -> Bool
|
||||
connDirect Connection {connLevel, viaGroupLink} = connLevel == 0 && not viaGroupLink
|
||||
|
||||
directOrUsed :: Contact -> Bool
|
||||
directOrUsed ct@Contact {contactUsed} =
|
||||
|
|
|
|||
|
|
@ -364,6 +364,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
|||
CRMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning]
|
||||
CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel testView e
|
||||
CRChatError u e -> ttyUser' u $ viewChatError logLevel testView e
|
||||
CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError logLevel testView) errs
|
||||
CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
|
||||
CRTimedAction _ _ -> []
|
||||
where
|
||||
|
|
|
|||
|
|
@ -275,8 +275,8 @@ getTermLine cc =
|
|||
5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case
|
||||
Just s -> do
|
||||
-- remove condition to always echo virtual terminal
|
||||
-- when True $ do
|
||||
when (printOutput cc) $ do
|
||||
-- when True $ do
|
||||
name <- userName cc
|
||||
putStrLn $ name <> ": " <> s
|
||||
pure s
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
module ChatTests where
|
||||
|
||||
import ChatTests.ChatList
|
||||
import ChatTests.Direct
|
||||
import ChatTests.Files
|
||||
import ChatTests.Groups
|
||||
|
|
@ -12,3 +13,4 @@ chatTests = do
|
|||
describe "group tests" chatGroupTests
|
||||
describe "file tests" chatFileTests
|
||||
describe "profile tests" chatProfileTests
|
||||
describe "chat list pagination tests" chatListTests
|
||||
|
|
|
|||
227
tests/ChatTests/ChatList.hs
Normal file
227
tests/ChatTests/ChatList.hs
Normal file
|
|
@ -0,0 +1,227 @@
|
|||
module ChatTests.ChatList where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.Utils
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import Data.Time.Format.ISO8601 (iso8601Show)
|
||||
import Test.Hspec
|
||||
|
||||
chatListTests :: SpecWith FilePath
|
||||
chatListTests = do
|
||||
it "get last chats" testPaginationLast
|
||||
it "get chats before/after timestamp" testPaginationTs
|
||||
it "filter by search query" testFilterSearch
|
||||
it "filter favorite" testFilterFavorite
|
||||
it "filter unread" testFilterUnread
|
||||
it "filter favorite or unread" testFilterFavoriteOrUnread
|
||||
it "sort and filter chats of all types" testPaginationAllChatTypes
|
||||
|
||||
testPaginationLast :: HasCallStack => FilePath -> IO ()
|
||||
testPaginationLast =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
connectUsers alice cath
|
||||
cath <##> alice
|
||||
|
||||
alice ##> "/chats 0"
|
||||
alice ##> "/chats 1"
|
||||
alice <# "@cath hey"
|
||||
alice ##> "/chats 2"
|
||||
alice <# "bob> hey"
|
||||
alice <# "@cath hey"
|
||||
|
||||
testPaginationTs :: HasCallStack => FilePath -> IO ()
|
||||
testPaginationTs =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
tsStart <- iso8601Show <$> getCurrentTime
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
tsAliceBob <- iso8601Show <$> getCurrentTime
|
||||
connectUsers alice cath
|
||||
cath <##> alice
|
||||
tsFinish <- iso8601Show <$> getCurrentTime
|
||||
-- syntax smoke check
|
||||
getChats_ alice "count=0" []
|
||||
getChats_ alice ("after=" <> tsFinish <> " count=2") []
|
||||
getChats_ alice ("before=" <> tsFinish <> " count=0") []
|
||||
-- limited reads
|
||||
getChats_ alice "count=1" [("@cath", "hey")]
|
||||
getChats_ alice ("after=" <> tsStart <> " count=1") [("@bob", "hey")]
|
||||
getChats_ alice ("before=" <> tsFinish <> " count=1") [("@cath", "hey")]
|
||||
-- interval bounds
|
||||
getChats_ alice ("after=" <> tsAliceBob <> " count=10") [("@cath", "hey")]
|
||||
getChats_ alice ("before=" <> tsAliceBob <> " count=10") [("@bob", "hey")]
|
||||
|
||||
getChats_ :: HasCallStack => TestCC -> String -> [(String, String)] -> Expectation
|
||||
getChats_ cc query expected = do
|
||||
cc #$> ("/_get chats 1 pcc=on " <> query, chats, expected)
|
||||
|
||||
testFilterSearch :: HasCallStack => FilePath -> IO ()
|
||||
testFilterSearch =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
connectUsers alice cath
|
||||
cath <##> alice
|
||||
|
||||
let query s = "count=1 {\"type\": \"search\", \"search\": \"" <> s <> "\"}"
|
||||
|
||||
getChats_ alice (query "abc") []
|
||||
getChats_ alice (query "alice") []
|
||||
getChats_ alice (query "bob") [("@bob", "hey")]
|
||||
getChats_ alice (query "Bob") [("@bob", "hey")]
|
||||
|
||||
testFilterFavorite :: HasCallStack => FilePath -> IO ()
|
||||
testFilterFavorite =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
connectUsers alice cath
|
||||
cath <##> alice
|
||||
|
||||
let query = "{\"type\": \"filters\", \"favorite\": true, \"unread\": false}"
|
||||
|
||||
-- no favorite chats
|
||||
getChats_ alice query []
|
||||
|
||||
-- 1 favorite chat
|
||||
alice ##> "/_settings @2 {\"enableNtfs\":\"all\",\"favorite\":true}"
|
||||
alice <## "ok"
|
||||
getChats_ alice query [("@bob", "hey")]
|
||||
|
||||
-- 1 favorite chat, unread chat not included
|
||||
alice ##> "/_unread chat @3 on"
|
||||
alice <## "ok"
|
||||
getChats_ alice query [("@bob", "hey")]
|
||||
|
||||
testFilterUnread :: HasCallStack => FilePath -> IO ()
|
||||
testFilterUnread =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
connectUsers alice cath
|
||||
cath <##> alice
|
||||
|
||||
let query = "{\"type\": \"filters\", \"favorite\": false, \"unread\": true}"
|
||||
|
||||
-- no unread chats
|
||||
getChats_ alice query []
|
||||
|
||||
-- 1 unread chat
|
||||
alice ##> "/_unread chat @2 on"
|
||||
alice <## "ok"
|
||||
getChats_ alice query [("@bob", "hey")]
|
||||
|
||||
-- 1 unread chat, favorite chat not included
|
||||
alice ##> "/_settings @3 {\"enableNtfs\":\"all\",\"favorite\":true}"
|
||||
alice <## "ok"
|
||||
getChats_ alice query [("@bob", "hey")]
|
||||
|
||||
testFilterFavoriteOrUnread :: HasCallStack => FilePath -> IO ()
|
||||
testFilterFavoriteOrUnread =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
connectUsers alice cath
|
||||
cath <##> alice
|
||||
|
||||
let query = "{\"type\": \"filters\", \"favorite\": true, \"unread\": true}"
|
||||
|
||||
-- no favorite or unread chats
|
||||
getChats_ alice query []
|
||||
|
||||
-- 1 unread chat
|
||||
alice ##> "/_unread chat @2 on"
|
||||
alice <## "ok"
|
||||
getChats_ alice query [("@bob", "hey")]
|
||||
|
||||
-- 1 favorite chat
|
||||
alice ##> "/_unread chat @2 off"
|
||||
alice <## "ok"
|
||||
alice ##> "/_settings @3 {\"enableNtfs\":\"all\",\"favorite\":true}"
|
||||
alice <## "ok"
|
||||
getChats_ alice query [("@cath", "hey")]
|
||||
|
||||
-- 1 unread chat, 1 favorite chat
|
||||
alice ##> "/_unread chat @2 on"
|
||||
alice <## "ok"
|
||||
getChats_ alice query [("@cath", "hey"), ("@bob", "hey")]
|
||||
|
||||
testPaginationAllChatTypes :: HasCallStack => FilePath -> IO ()
|
||||
testPaginationAllChatTypes =
|
||||
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
ts1 <- iso8601Show <$> getCurrentTime
|
||||
|
||||
-- @bob
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
|
||||
ts2 <- iso8601Show <$> getCurrentTime
|
||||
|
||||
-- <@cath
|
||||
alice ##> "/ad"
|
||||
cLink <- getContactLink alice True
|
||||
cath ##> ("/c " <> cLink)
|
||||
alice <#? cath
|
||||
|
||||
ts3 <- iso8601Show <$> getCurrentTime
|
||||
|
||||
-- :3
|
||||
alice ##> "/c"
|
||||
_ <- getInvitation alice
|
||||
|
||||
ts4 <- iso8601Show <$> getCurrentTime
|
||||
|
||||
-- #team
|
||||
alice ##> "/g team"
|
||||
alice <## "group #team is created"
|
||||
alice <## "to add members use /a team <name> or /create link #team"
|
||||
|
||||
ts5 <- iso8601Show <$> getCurrentTime
|
||||
|
||||
-- @dan
|
||||
connectUsers alice dan
|
||||
alice <##> dan
|
||||
|
||||
ts6 <- iso8601Show <$> getCurrentTime
|
||||
|
||||
getChats_ alice "count=10" [("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")]
|
||||
getChats_ alice "count=3" [("@dan", "hey"), ("#team", ""), (":3", "")]
|
||||
getChats_ alice ("after=" <> ts2 <> " count=2") [(":3", ""), ("<@cath", "")]
|
||||
getChats_ alice ("before=" <> ts5 <> " count=2") [("#team", ""), (":3", "")]
|
||||
getChats_ alice ("after=" <> ts3 <> " count=10") [("@dan", "hey"), ("#team", ""), (":3", "")]
|
||||
getChats_ alice ("before=" <> ts4 <> " count=10") [(":3", ""), ("<@cath", ""), ("@bob", "hey")]
|
||||
getChats_ alice ("after=" <> ts1 <> " count=10") [("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")]
|
||||
getChats_ alice ("before=" <> ts6 <> " count=10") [("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")]
|
||||
getChats_ alice ("after=" <> ts6 <> " count=10") []
|
||||
getChats_ alice ("before=" <> ts1 <> " count=10") []
|
||||
|
||||
let queryFavorite = "{\"type\": \"filters\", \"favorite\": true, \"unread\": false}"
|
||||
getChats_ alice queryFavorite []
|
||||
|
||||
alice ##> "/_settings @2 {\"enableNtfs\":\"all\",\"favorite\":true}"
|
||||
alice <## "ok"
|
||||
alice ##> "/_settings #1 {\"enableNtfs\":\"all\",\"favorite\":true}"
|
||||
alice <## "ok"
|
||||
|
||||
getChats_ alice queryFavorite [("#team", ""), ("@bob", "hey")]
|
||||
getChats_ alice ("before=" <> ts4 <> " count=1 " <> queryFavorite) [("@bob", "hey")]
|
||||
getChats_ alice ("before=" <> ts5 <> " count=1 " <> queryFavorite) [("#team", "")]
|
||||
getChats_ alice ("after=" <> ts1 <> " count=1 " <> queryFavorite) [("@bob", "hey")]
|
||||
getChats_ alice ("after=" <> ts4 <> " count=1 " <> queryFavorite) [("#team", "")]
|
||||
|
||||
let queryUnread = "{\"type\": \"filters\", \"favorite\": false, \"unread\": true}"
|
||||
|
||||
getChats_ alice queryUnread [("<@cath", "")]
|
||||
getChats_ alice ("before=" <> ts2 <> " count=10 " <> queryUnread) []
|
||||
getChats_ alice ("before=" <> ts3 <> " count=10 " <> queryUnread) [("<@cath", "")]
|
||||
getChats_ alice ("after=" <> ts2 <> " count=10 " <> queryUnread) [("<@cath", "")]
|
||||
getChats_ alice ("after=" <> ts3 <> " count=10 " <> queryUnread) []
|
||||
Loading…
Add table
Reference in a new issue