From 48ba6472b69fef04feda9717bbbc8eff3b5a6738 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 24 Apr 2022 09:05:54 +0100 Subject: [PATCH] core: add updatedAt to UserContactRequest and to PendingContactConnection, use it to sort the list of chats, tests (#563) --- src/Simplex/Chat.hs | 2 +- src/Simplex/Chat/Store.hs | 32 ++++++++++++++++---------------- src/Simplex/Chat/Types.hs | 6 ++++-- src/Simplex/Chat/View.hs | 12 ++++++------ tests/ChatTests.hs | 30 ++++++++++++++++++++++++------ 5 files changed, 51 insertions(+), 31 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index f7abde0677..fefff17157 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1899,7 +1899,7 @@ chatCommandP = <|> ("/user" <|> "/u") $> ShowActiveUser <|> "/_start" $> StartChat <|> "/_files_folder " *> (SetFilesFolder <$> filePath) - <|> "/_get chats" *> (APIGetChats <$> (" connections" $> True <|> pure False)) + <|> "/_get chats" *> (APIGetChats <$> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)) <|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP) <|> "/_get items count=" *> (APIGetChatItems <$> A.decimal) <|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <*> optional filePathTagged <*> optional quotedItemIdTagged <* A.space <*> msgContentP) diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 6d6e767308..0041312313 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -312,7 +312,7 @@ createConnReqConnection st userId acId cReqHash xContactId = do |] (userId, acId, pccConnStatus, ConnContact, createdAt, createdAt, cReqHash, xContactId) pccConnId <- insertedRowId db - pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, createdAt} + pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, createdAt, updatedAt = createdAt} getConnReqContactXContactId :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnReqUriHash -> m (Maybe Contact, Maybe XContactId) getConnReqContactXContactId st userId cReqHash = do @@ -361,7 +361,7 @@ createDirectConnection st userId acId pccConnStatus = |] (userId, acId, pccConnStatus, ConnContact, createdAt, createdAt) pccConnId <- insertedRowId db - pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, createdAt, viaContactUri = False} + pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, createdAt, updatedAt = createdAt} createContactConnection_ :: DB.Connection -> UserId -> ConnId -> Maybe Int64 -> Int -> UTCTime -> IO Connection createContactConnection_ db userId = createConnection_ db userId ConnContact Nothing @@ -718,7 +718,7 @@ createOrUpdateContactRequest_ db userId userContactLinkId invId Profile {display [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, cr.created_at, cr.xcontact_id + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, cr.created_at, cr.updated_at FROM contact_requests cr JOIN connections c USING (user_contact_link_id) JOIN contact_profiles p USING (contact_profile_id) @@ -777,7 +777,7 @@ getContactRequest_ db userId contactRequestId = [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, cr.created_at, cr.xcontact_id + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, cr.created_at, cr.updated_at FROM contact_requests cr JOIN connections c USING (user_contact_link_id) JOIN contact_profiles p USING (contact_profile_id) @@ -786,12 +786,12 @@ getContactRequest_ db userId contactRequestId = |] (userId, contactRequestId) -type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, UTCTime, Maybe XContactId) +type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe XContactId, UTCTime, UTCTime) toContactRequest :: ContactRequestRow -> UserContactRequest -toContactRequest (contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, createdAt, xContactId) = do +toContactRequest (contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, xContactId, createdAt, updatedAt) = do let profile = Profile {displayName, fullName, image} - in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, localDisplayName, profileId, profile, createdAt, xContactId} + in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt} getContactRequestIdByName :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m Int64 getContactRequestIdByName st userId cName = @@ -2526,8 +2526,8 @@ getChatPreviews st user withPCC = ts (AChat _ Chat {chatInfo}) = case chatInfo of DirectChat Contact {createdAt} -> createdAt GroupChat GroupInfo {createdAt} -> createdAt - ContactRequest UserContactRequest {createdAt} -> createdAt - ContactConnection PendingContactConnection {createdAt} -> createdAt + ContactRequest UserContactRequest {updatedAt} -> updatedAt + ContactConnection PendingContactConnection {updatedAt} -> updatedAt chatItemTs :: CChatItem d -> UTCTime chatItemTs (CChatItem _ ChatItem {meta = CIMeta {itemTs}}) = itemTs @@ -2671,7 +2671,7 @@ getContactRequestChatPreviews_ db User {userId} = [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, cr.created_at, cr.xcontact_id + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, cr.created_at, cr.updated_at FROM contact_requests cr JOIN connections c USING (user_contact_link_id) JOIN contact_profiles p USING (contact_profile_id) @@ -2692,13 +2692,13 @@ getContactConnectionChatPreviews_ db User {userId} _ = <$> DB.query db [sql| - SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, created_at + SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, 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 |] (userId, ConnContact) where - toContactConnectionChatPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, UTCTime) -> AChat + toContactConnectionChatPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, UTCTime, UTCTime) -> AChat toContactConnectionChatPreview connRow = let conn = toPendingContactConnection connRow stats = ChatStats {unreadCount = 0, minUnreadItemId = 0} @@ -2712,7 +2712,7 @@ deletePendingContactConnection st userId connId = DB.query db [sql| - SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, created_at + SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, 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 |] @@ -2720,9 +2720,9 @@ deletePendingContactConnection st userId connId = liftIO $ DB.execute db "DELETE FROM connections WHERE connection_id = ?" (Only connId) pure conn -toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, UTCTime) -> PendingContactConnection -toPendingContactConnection (pccConnId, acId, pccConnStatus, connReqHash, createdAt) = - PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = isJust connReqHash, createdAt} +toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, UTCTime, UTCTime) -> PendingContactConnection +toPendingContactConnection (pccConnId, acId, pccConnStatus, connReqHash, createdAt, updatedAt) = + PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = isJust connReqHash, createdAt, updatedAt} getDirectChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> ChatPagination -> m (Chat 'CTDirect) getDirectChat st user contactId pagination = diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 65f2fa4565..9d8626e92d 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -99,6 +99,7 @@ data UserContactRequest = UserContactRequest profileId :: Int64, profile :: Profile, createdAt :: UTCTime, + updatedAt :: UTCTime, xContactId :: Maybe XContactId } deriving (Eq, Show, Generic) @@ -670,7 +671,8 @@ data PendingContactConnection = PendingContactConnection pccAgentConnId :: AgentConnId, pccConnStatus :: ConnStatus, viaContactUri :: Bool, - createdAt :: UTCTime + createdAt :: UTCTime, + updatedAt :: UTCTime } deriving (Eq, Show, Generic) @@ -691,7 +693,7 @@ data ConnStatus ConnReady | -- | connection deleted ConnDeleted - deriving (Eq, Show) + deriving (Eq, Show, Read) instance FromField ConnStatus where fromField = fromTextField_ textDecode diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 2c5a6463a8..7d4ed007d7 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -142,7 +142,7 @@ responseToView testView = \case CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"] CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"] CRNewContactConnection _ -> [] - CRContactConnectionDeleted _ -> [] + CRContactConnectionDeleted PendingContactConnection {pccConnId} -> ["connection :" <> sShow pccConnId <> " deleted"] CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)] CRMessageError prefix err -> [plain prefix <> ": " <> plain err] CRChatError e -> viewChatError e @@ -150,11 +150,11 @@ responseToView testView = \case testViewChats :: [AChat] -> [StyledString] testViewChats chats = [sShow $ map toChatView chats] where - toChatView :: AChat -> (Text, Text) - toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName}) items _)) = ("@" <> localDisplayName, toCIPreview items) - toChatView (AChat _ (Chat (GroupChat GroupInfo {localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items) - toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items) - toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items) + toChatView :: AChat -> (Text, Text, Maybe ConnStatus) + toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items, Just $ connStatus activeConn) + toChatView (AChat _ (Chat (GroupChat GroupInfo {localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items, Nothing) + toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items, Nothing) + toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items, Just $ pccConnStatus) toCIPreview :: [CChatItem c] -> Text toCIPreview ((CChatItem _ ChatItem {meta}) : _) = itemText meta toCIPreview _ = "" diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 2711fcf3f6..42f69540d3 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -13,7 +13,7 @@ import qualified Data.ByteString as B import Data.Char (isDigit) import qualified Data.Text as T import Simplex.Chat.Controller (ChatController (..)) -import Simplex.Chat.Types (ImageData (..), Profile (..), User (..)) +import Simplex.Chat.Types (ConnStatus (..), ImageData (..), Profile (..), User (..)) import Simplex.Chat.Util (unlessM) import System.Directory (copyFile, doesFileExist) import Test.Hspec @@ -1568,12 +1568,14 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $ bob ##> ("/c " <> cLink) alice <#? bob alice @@@ [("<@bob", "")] + bob @@@! [(":1", "", Just ConnJoined)] bob ##> ("/c " <> cLink) alice <#? bob bob ##> ("/c " <> cLink) alice <#? bob alice @@@ [("<@bob", "")] + bob @@@! [(":3", "", Just ConnJoined), (":2", "", Just ConnJoined), (":1", "", Just ConnJoined)] alice ##> "/ac bob" alice <## "bob (Bob): accepting contact request..." @@ -1584,7 +1586,11 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $ bob ##> ("/c " <> cLink) bob <## "alice (Alice): contact already exists" alice @@@ [("@bob", "")] - bob @@@ [("@alice", "")] + bob @@@ [("@alice", ""), (":2", ""), (":1", "")] + bob ##> "/_delete :1" + bob <## "connection :1 deleted" + bob ##> "/_delete :2" + bob <## "connection :2 deleted" alice <##> bob alice @@@ [("@bob", "hey")] @@ -1650,7 +1656,13 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile bob ##> ("/c " <> cLink) bob <## "alice (Alice): contact already exists" alice @@@ [("@robert", "")] - bob @@@ [("@alice", "")] + bob @@@ [("@alice", ""), (":3", ""), (":2", ""), (":1", "")] + bob ##> "/_delete :1" + bob <## "connection :1 deleted" + bob ##> "/_delete :2" + bob <## "connection :2 deleted" + bob ##> "/_delete :3" + bob <## "connection :3 deleted" alice <##> bob alice @@@ [("@robert", "hey")] @@ -1872,10 +1884,16 @@ chat'' :: String -> [((Int, String), Maybe (Int, String), Maybe String)] chat'' = read (@@@) :: TestCC -> [(String, String)] -> Expectation -cc @@@ chats = do - cc ##> "/_get chats" +(@@@) = getChats . map $ \(ldn, msg, _) -> (ldn, msg) + +(@@@!) :: TestCC -> [(String, String, Maybe ConnStatus)] -> Expectation +(@@@!) = getChats id + +getChats :: (Eq a, Show a) => ([(String, String, Maybe ConnStatus)] -> [a]) -> TestCC -> [a] -> Expectation +getChats f cc res = do + cc ##> "/_get chats pcc=on" line <- getTermLine cc - read line `shouldMatchList` chats + f (read line) `shouldMatchList` res send :: TestCC -> String -> IO () send TestCC {chatController = cc} cmd = atomically $ writeTBQueue (inputQ cc) cmd