From e29ea99d2cb99ea93fd0d0bcd39a4a0cb414e18f Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 30 Jan 2022 21:51:23 +0000 Subject: [PATCH] getChats returns [Chat] with 0-1 item instead of [ChatPreview] (#240) --- src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Messages.hs | 23 ------------------- src/Simplex/Chat/Store.hs | 40 +++++++++++++++++----------------- 3 files changed, 21 insertions(+), 44 deletions(-) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 9dd0aac971..13eb6f2424 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -117,7 +117,7 @@ data ChatCommand deriving (Show) data ChatResponse - = CRApiChats {chats :: [AChatPreview]} + = CRApiChats {chats :: [AChat]} | CRApiChat {chat :: AChat} | CRNewChatItem {chatItem :: AChatItem} | CRCmdAccepted {corr :: CorrId} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index c7b26de99f..c4780ea34e 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -146,13 +146,6 @@ instance ToJSON (Chat c) where toJSON = J.genericToJSON J.defaultOptions toEncoding = J.genericToEncoding J.defaultOptions -data ChatPreview c = ChatPreview {chatInfo :: ChatInfo c, lastChatItem :: Maybe (CChatItem c)} - deriving (Show, Generic) - -instance ToJSON (ChatPreview c) where - toJSON = J.genericToJSON J.defaultOptions - toEncoding = J.genericToEncoding J.defaultOptions - data AChat = forall c. AChat (SChatType c) (Chat c) deriving instance Show AChat @@ -161,22 +154,6 @@ instance ToJSON AChat where toJSON (AChat _ c) = J.toJSON c toEncoding (AChat _ c) = J.toEncoding c --- | type to show the list of chats, with one last message in each -data AChatPreview = forall c. AChatPreview (SChatType c) (ChatInfo c) (Maybe (CChatItem c)) - -deriving instance Show AChatPreview - -instance ToJSON AChatPreview where - toJSON (AChatPreview _ chat ccItem_) = J.toJSON $ JSONAnyChatPreview chat ccItem_ - toEncoding (AChatPreview _ chat ccItem_) = J.toEncoding $ J.toJSON $ JSONAnyChatPreview chat ccItem_ - -data JSONAnyChatPreview c d = JSONAnyChatPreview {chatInfo :: ChatInfo c, chatItem :: Maybe (CChatItem c)} - deriving (Generic) - -instance ToJSON (JSONAnyChatPreview c d) where - toJSON = J.genericToJSON J.defaultOptions - toEncoding = J.genericToEncoding J.defaultOptions - -- | type to show a mix of messages from multiple chats data AChatItem = forall c d. AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d) diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index f867744eed..e7f4db1611 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -1823,18 +1823,18 @@ createNewChatItem st userId chatDirection NewChatItem {createdByMsgId, itemSent, CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing) CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId) -getChatPreviews :: MonadUnliftIO m => SQLiteStore -> User -> m [AChatPreview] +getChatPreviews :: MonadUnliftIO m => SQLiteStore -> User -> m [AChat] getChatPreviews st user = liftIO . withTransaction st $ \db -> do directChatPreviews <- getDirectChatPreviews_ db user groupChatPreviews <- getGroupChatPreviews_ db user pure $ sortOn (Down . ts) (directChatPreviews <> groupChatPreviews) where - ts :: AChatPreview -> UTCTime - ts (AChatPreview _ _ Nothing) = UTCTime (fromGregorian 2122 1 29) (secondsToDiffTime 0) -- TODO Contact/GroupInfo createdAt - ts (AChatPreview _ _ (Just (CChatItem _ (ChatItem _ CIMeta {itemTs} _)))) = itemTs + ts :: AChat -> UTCTime + ts (AChat _ (Chat _ [])) = UTCTime (fromGregorian 2122 1 29) (secondsToDiffTime 0) -- TODO Contact/GroupInfo createdAt + ts (AChat _ (Chat _ (CChatItem _ (ChatItem _ CIMeta {itemTs} _) : _))) = itemTs -getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChatPreview] +getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChat] getDirectChatPreviews_ db User {userId} = do tz <- getCurrentTimeZone map (toDirectChatPreview tz) @@ -1865,13 +1865,13 @@ getDirectChatPreviews_ db User {userId} = do |] (Only userId) where - toDirectChatPreview :: TimeZone -> ContactRow :. MaybeChatItemRow -> AChatPreview + toDirectChatPreview :: TimeZone -> ContactRow :. MaybeChatItemRow -> AChat toDirectChatPreview tz (contactRow :. ciRow_) = let contact = toContact' contactRow - ci_ = toMaybeDirectChatItem tz ciRow_ - in AChatPreview SCTDirect (DirectChat contact) ci_ + ci_ = toDirectChatItemList tz ciRow_ + in AChat SCTDirect $ Chat (DirectChat contact) ci_ -getGroupChatPreviews_ :: DB.Connection -> User -> IO [AChatPreview] +getGroupChatPreviews_ :: DB.Connection -> User -> IO [AChat] getGroupChatPreviews_ db User {userId, userContactId} = do tz <- getCurrentTimeZone map (toGroupChatPreview tz) @@ -1910,12 +1910,12 @@ getGroupChatPreviews_ db User {userId, userContactId} = do |] (userId, userContactId) where - toGroupChatPreview :: TimeZone -> GroupInfoRow :. MaybeGroupChatItemRow -> AChatPreview + toGroupChatPreview :: TimeZone -> GroupInfoRow :. MaybeGroupChatItemRow -> AChat toGroupChatPreview tz (((groupId, localDisplayName, displayName, fullName) :. userMemberRow) :. ciRow_) = let membership = toGroupMember userContactId userMemberRow groupInfo = GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName}, membership} - ci_ = toMaybeGroupChatItem tz userContactId ciRow_ - in AChatPreview SCTGroup (GroupChat groupInfo) ci_ + ci_ = toGroupChatItemList tz userContactId ciRow_ + in AChat SCTGroup $ Chat (GroupChat groupInfo) ci_ getDirectChat :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m (Chat 'CTDirect) getDirectChat st userId contactId = @@ -2051,10 +2051,10 @@ toDirectChatItem tz (itemId, itemTs, itemContent, itemText, createdAt) = ACIContent d@SMDSnd ciContent -> CChatItem d $ ChatItem CIDirectSnd ciMeta ciContent ACIContent d@SMDRcv ciContent -> CChatItem d $ ChatItem CIDirectRcv ciMeta ciContent -toMaybeDirectChatItem :: TimeZone -> MaybeChatItemRow -> Maybe (CChatItem 'CTDirect) -toMaybeDirectChatItem tz (Just itemId, Just itemTs, Just itemContent, Just itemText, Just createdAt) = - Just $ toDirectChatItem tz (itemId, itemTs, itemContent, itemText, createdAt) -toMaybeDirectChatItem _ _ = Nothing +toDirectChatItemList :: TimeZone -> MaybeChatItemRow -> [CChatItem 'CTDirect] +toDirectChatItemList tz (Just itemId, Just itemTs, Just itemContent, Just itemText, Just createdAt) = + [toDirectChatItem tz (itemId, itemTs, itemContent, itemText, createdAt)] +toDirectChatItemList _ _ = [] type GroupChatItemRow = ChatItemRow :. MaybeGroupMemberRow @@ -2069,10 +2069,10 @@ toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, create (ACIContent d@SMDRcv ciContent, Just member) -> Right $ CChatItem d (ChatItem (CIGroupRcv member) ciMeta ciContent) _ -> Left $ SEBadChatItem itemId -toMaybeGroupChatItem :: TimeZone -> Int64 -> MaybeGroupChatItemRow -> Maybe (CChatItem 'CTGroup) -toMaybeGroupChatItem tz userContactId ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just createdAt) :. memberRow_) = - eitherToMaybe $ toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, createdAt) :. memberRow_) -toMaybeGroupChatItem _ _ _ = Nothing +toGroupChatItemList :: TimeZone -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup] +toGroupChatItemList tz userContactId ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just createdAt) :. memberRow_) = + either (const []) (: []) $ toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, createdAt) :. memberRow_) +toGroupChatItemList _ _ _ = [] -- | Saves unique local display name based on passed displayName, suffixed with _N if required. -- This function should be called inside transaction.