diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 40a1539dc..d9d06f870 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -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 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 6e3d29940..9c06e80d2 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index c3bf84b33..04c47a646 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -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) diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 77c053fdf..9604b7183 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -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 diff --git a/src/Simplex/Chat/Migrations/M20221222_chat_ts.hs b/src/Simplex/Chat/Migrations/M20221222_chat_ts.hs index 5cadd03fe..9a83c8182 100644 --- a/src/Simplex/Chat/Migrations/M20221222_chat_ts.hs +++ b/src/Simplex/Chat/Migrations/M20221222_chat_ts.hs @@ -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 |] diff --git a/src/Simplex/Chat/Migrations/M20231207_chat_list_pagination.hs b/src/Simplex/Chat/Migrations/M20231207_chat_list_pagination.hs new file mode 100644 index 000000000..cf272ae65 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20231207_chat_list_pagination.hs @@ -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; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 19b4d7237..ab431f84d 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -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 +); diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 0046bc990..7504f19c9 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -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 = diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 75df49561..302f9bbb5 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -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 diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 102612b4e..9986eacf6 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -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 <- diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 31d0525db..c8a04c42a 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -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 diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index c51a3e499..ce1d17859 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -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| diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 93c3ab197..e1125adc3 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -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) diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 3f66aa321..d5a130091 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -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} = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 7eeddefbc..f801e3075 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -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 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 824e6be0a..665ef33f9 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -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 diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index eeb96503e..a00274a54 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -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 diff --git a/tests/ChatTests/ChatList.hs b/tests/ChatTests/ChatList.hs new file mode 100644 index 000000000..f42067c7e --- /dev/null +++ b/tests/ChatTests/ChatList.hs @@ -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 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) []