diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index dbccfbdfcf..d43b2d8c64 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -611,6 +611,8 @@ processChatCommand = \case CTGroup -> do groupChat <- withStore (\db -> getGroupChat db user cId pagination search) pure $ CRApiChat user (AChat SCTGroup groupChat) + CTSelf -> do + error "TODO: APIGetChat.CTSelf" CTContactRequest -> pure $ chatCmdError (Just user) "not implemented" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIGetChatItems pagination search -> withUser $ \user -> do @@ -965,6 +967,8 @@ processChatCommand = \case startProximateTimedItemThread user (ChatRef CTGroup chatId, itemId) deleteAt withStore' $ \db -> updateGroupChatItemsRead db userId chatId fromToIds ok user + CTSelf -> do + error "TODO: APIChatRead.CTSelf" CTContactRequest -> pure $ chatCmdError Nothing "not supported" CTContactConnection -> pure $ chatCmdError Nothing "not supported" APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user -> case cType of @@ -1034,6 +1038,7 @@ processChatCommand = \case withStore' (\db -> setContactDeleted db user ct) `catchChatError` (toView . CRChatError (Just user)) pure $ map aConnId conns + CTSelf -> error "TODO: APIDeleteChat.CTSelf" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" APIClearChat (ChatRef cType chatId) -> withUser $ \user -> case cType of CTDirect -> do @@ -1050,6 +1055,8 @@ processChatCommand = \case membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo) + CTSelf -> do + error "TODO: APIClearChat.CTSelf" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" APIAcceptContact incognito connReqId -> withUser $ \_ -> withChatLock "acceptContact" $ do diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 9604b71838..25020e527d 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -47,7 +47,7 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextFie import Simplex.Messaging.Protocol (MsgBody) import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) -data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection +data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection | CTSelf deriving (Eq, Show, Ord) data ChatName = ChatName {chatType :: ChatType, chatName :: Text} @@ -59,6 +59,7 @@ chatTypeStr = \case CTGroup -> "#" CTContactRequest -> "<@" CTContactConnection -> ":" + CTSelf -> "~" chatNameStr :: ChatName -> String chatNameStr (ChatName cType name) = T.unpack $ chatTypeStr cType <> if T.any isSpace name then "'" <> name <> "'" else name @@ -69,6 +70,7 @@ data ChatRef = ChatRef ChatType Int64 data ChatInfo (c :: ChatType) where DirectChat :: Contact -> ChatInfo 'CTDirect GroupChat :: GroupInfo -> ChatInfo 'CTGroup + SelfChat :: UTCTime -> ChatInfo 'CTSelf ContactRequest :: UserContactRequest -> ChatInfo 'CTContactRequest ContactConnection :: PendingContactConnection -> ChatInfo 'CTContactConnection @@ -84,6 +86,7 @@ chatInfoUpdatedAt :: ChatInfo c -> UTCTime chatInfoUpdatedAt = \case DirectChat Contact {updatedAt} -> updatedAt GroupChat GroupInfo {updatedAt} -> updatedAt + SelfChat updatedAt -> updatedAt ContactRequest UserContactRequest {updatedAt} -> updatedAt ContactConnection PendingContactConnection {updatedAt} -> updatedAt @@ -91,6 +94,7 @@ chatInfoToRef :: ChatInfo c -> ChatRef chatInfoToRef = \case DirectChat Contact {contactId} -> ChatRef CTDirect contactId GroupChat GroupInfo {groupId} -> ChatRef CTGroup groupId + SelfChat {} -> ChatRef CTSelf 0 ContactRequest UserContactRequest {contactRequestId} -> ChatRef CTContactRequest contactRequestId ContactConnection PendingContactConnection {pccConnId} -> ChatRef CTContactConnection pccConnId @@ -102,6 +106,7 @@ chatInfoMembership = \case data JSONChatInfo = JCInfoDirect {contact :: Contact} | JCInfoGroup {groupInfo :: GroupInfo} + | JCInfoSelf {updatedAt :: UTCTime} | JCInfoContactRequest {contactRequest :: UserContactRequest} | JCInfoContactConnection {contactConnection :: PendingContactConnection} @@ -118,6 +123,7 @@ jsonChatInfo :: ChatInfo c -> JSONChatInfo jsonChatInfo = \case DirectChat c -> JCInfoDirect c GroupChat g -> JCInfoGroup g + SelfChat s -> JCInfoSelf s ContactRequest g -> JCInfoContactRequest g ContactConnection c -> JCInfoContactConnection c @@ -129,6 +135,7 @@ jsonAChatInfo :: JSONChatInfo -> AChatInfo jsonAChatInfo = \case JCInfoDirect c -> AChatInfo SCTDirect $ DirectChat c JCInfoGroup g -> AChatInfo SCTGroup $ GroupChat g + JCInfoSelf s -> AChatInfo SCTSelf $ SelfChat s JCInfoContactRequest g -> AChatInfo SCTContactRequest $ ContactRequest g JCInfoContactConnection c -> AChatInfo SCTContactConnection $ ContactConnection c @@ -718,6 +725,7 @@ data SChatType (c :: ChatType) where SCTGroup :: SChatType 'CTGroup SCTContactRequest :: SChatType 'CTContactRequest SCTContactConnection :: SChatType 'CTContactConnection + SCTSelf :: SChatType 'CTSelf deriving instance Show (SChatType c) @@ -726,6 +734,7 @@ instance TestEquality SChatType where testEquality SCTGroup SCTGroup = Just Refl testEquality SCTContactRequest SCTContactRequest = Just Refl testEquality SCTContactConnection SCTContactConnection = Just Refl + testEquality SCTSelf SCTSelf = Just Refl testEquality _ _ = Nothing data AChatType = forall c. ChatTypeI c => ACT (SChatType c) @@ -741,12 +750,15 @@ instance ChatTypeI 'CTContactRequest where chatTypeI = SCTContactRequest instance ChatTypeI 'CTContactConnection where chatTypeI = SCTContactConnection +instance ChatTypeI 'CTSelf where chatTypeI = SCTSelf + toChatType :: SChatType c -> ChatType toChatType = \case SCTDirect -> CTDirect SCTGroup -> CTGroup SCTContactRequest -> CTContactRequest SCTContactConnection -> CTContactConnection + SCTSelf -> CTSelf aChatType :: ChatType -> AChatType aChatType = \case @@ -754,6 +766,7 @@ aChatType = \case CTGroup -> ACT SCTGroup CTContactRequest -> ACT SCTContactRequest CTContactConnection -> ACT SCTContactConnection + CTSelf -> ACT SCTSelf checkChatType :: forall t c c'. (ChatTypeI c, ChatTypeI c') => t c' -> Either String (t c) checkChatType x = case testEquality (chatTypeI @c) (chatTypeI @c') of diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index b817c844d5..348621b542 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -491,11 +491,12 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe getChatPreviews :: DB.Connection -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat] getChatPreviews db user withPCC pagination query = do + selfChat <- getSelfChatPreview_ db user pagination query 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] + let refs = sortTake $ concat [selfChat, directChats, groupChats, cReqChats, connChats] mapM (runExceptT <$> getChatPreview) refs where ts :: AChatPreviewData -> UTCTime @@ -504,6 +505,7 @@ getChatPreviews db user withPCC pagination query = do (GroupChatPD t _ _ _) -> t (ContactRequestPD t _) -> t (ContactConnectionPD t _) -> t + (SelfChatPD t _) -> t sortTake = case pagination of PTLast count -> take count . sortBy (comparing $ Down . ts) PTAfter _ count -> reverse . take count . sortBy (comparing ts) @@ -514,12 +516,14 @@ getChatPreviews db user withPCC pagination query = do SCTGroup -> getGroupChatPreview_ db user cpd SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat + SCTSelf -> let (SelfChatPD _ chat) = cpd in pure chat data ChatPreviewData (c :: ChatType) where DirectChatPD :: UTCTime -> ContactId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTDirect GroupChatPD :: UTCTime -> GroupId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTGroup ContactRequestPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactRequest ContactConnectionPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactConnection + SelfChatPD :: UTCTime -> AChat -> ChatPreviewData 'CTSelf data AChatPreviewData = forall c. ChatTypeI c => ACPD (SChatType c) (ChatPreviewData c) @@ -724,6 +728,39 @@ getGroupChatPreview_ db user (GroupChatPD _ groupId lastItemId_ stats) = do Nothing -> pure [] pure $ AChat SCTGroup (Chat (GroupChat groupInfo) lastItem stats) +getSelfChatPreview_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData] +getSelfChatPreview_ db User {userId} _pagination = \case + CLQFilters {favorite = False, unread = False} -> query + _ -> pure [] + where + query = + map toPreview + <$> DB.queryNamed + db + [sql| + SELECT + -- 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, + -- ChatItemModeRow + i.timed_ttl, i.timed_delete_at, i.item_live, + -- MaybeCIFIleRow + 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, + FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id + WHERE i.user_id := :user_id AND i.self_chat + ORDER BY ts DESC + LIMIT 1 + |] + [":user_id" := userId] + toPreview :: ChatItemRow -> AChatPreviewData + toPreview (ci :. ciMode :. ciFile_) = + let lastItem = error "TODO: lastItem" :: CChatItem CTSelf + ts = error "TODO: ts" :: UTCTime + stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} + aChat = AChat SCTSelf $ Chat (SelfChat ts) [lastItem] stats + in ACPD SCTSelf $ SelfChatPD ts aChat + getContactRequestChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData] getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of CLQFilters {favorite = False, unread = False} -> query ""