diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 4f9aff7650..5ae2477635 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -127,7 +127,7 @@ processChatCommand user@User {userId, profile} = \case APIGetChats -> CRApiChats <$> withStore (`getChatPreviews` user) APIGetChat cType cId -> case cType of CTDirect -> CRApiDirectChat <$> withStore (\st -> getDirectChat st user cId) - CTGroup -> pure $ CRChatError ChatErrorNotImplemented + CTGroup -> CRApiGroupChat <$> withStore (\st -> getGroupChat st user cId) APIGetChatItems _count -> pure $ CRChatError ChatErrorNotImplemented ChatHelp section -> pure $ CRChatHelp section Welcome -> pure $ CRWelcome user diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 7ef963d598..f15eade32a 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -118,6 +118,7 @@ data ChatCommand data ChatResponse = CRApiChats {chats :: [AChatPreview]} | CRApiDirectChat {chat :: Chat 'CTDirect} + | CRApiGroupChat {gChat :: Chat 'CTGroup} | CRNewChatItem {chatItem :: AChatItem} | CRCmdAccepted {corr :: CorrId} | CRChatHelp {helpSection :: HelpSection} diff --git a/src/Simplex/Chat/Migrations/chat_item_queries/getChatInfoListDirect.sql b/src/Simplex/Chat/Migrations/chat_item_queries/getChatInfoListDirect.sql deleted file mode 100644 index bc5279d517..0000000000 --- a/src/Simplex/Chat/Migrations/chat_item_queries/getChatInfoListDirect.sql +++ /dev/null @@ -1,39 +0,0 @@ -SELECT - c.contact_id, - cp.display_name, - cp.full_name, - cp.properties, - ci.chat_item_id, - ci.chat_msg_id, - ci.created_by_msg_id, - ci.item_sent, - ci.item_ts, - ci.item_deleted, - ci.item_text, - ci.item_content, - md.msg_delivery_id, - md.chat_ts, - md.agent_msg_meta, - mde.delivery_status, - mde.created_at -FROM contacts c -JOIN contact_profiles cp ON cp.contact_profile_id == c.contact_profile_id -JOIN ( - SELECT contact_id, chat_item_id, MAX(item_ts) MaxDate - FROM chat_items - WHERE item_deleted != 1 - GROUP BY contact_id, chat_item_id -) CIMaxDates ON CIMaxDates.contact_id = c.contact_id -LEFT JOIN chat_items ci ON ci.chat_item_id == CIMaxDates.chat_item_id - AND ci.item_ts == CIMaxDates.MaxDate -JOIN messages m ON m.message_id == ci.created_by_msg_id -JOIN msg_deliveries md ON md.message_id = m.message_id -JOIN ( - SELECT msg_delivery_id, MAX(created_at) MaxDate - FROM msg_delivery_events - GROUP BY msg_delivery_id -) MDEMaxDates ON MDEMaxDates.msg_delivery_id = md.msg_delivery_id -JOIN msg_delivery_events mde ON mde.msg_delivery_id = MDEMaxDates.msg_delivery_id - AND mde.created_at = MDEMaxDates.MaxDate -WHERE c.user_id = ? -ORDER BY ci.item_ts DESC diff --git a/src/Simplex/Chat/Migrations/chat_item_queries/getChatInfoListGroup.sql b/src/Simplex/Chat/Migrations/chat_item_queries/getChatInfoListGroup.sql deleted file mode 100644 index e1fbd4db55..0000000000 --- a/src/Simplex/Chat/Migrations/chat_item_queries/getChatInfoListGroup.sql +++ /dev/null @@ -1,45 +0,0 @@ -SELECT - g.group_id, - gp.display_name, - gp.full_name, - gp.properties, - gm.group_member_id, - cp.display_name, - cp.full_name, - cp.properties, - ci.chat_item_id, - ci.chat_msg_id, - ci.created_by_msg_id, - ci.item_sent, - ci.item_ts, - ci.item_deleted, - ci.item_text, - ci.item_content, - md.msg_delivery_id, - md.chat_ts, - md.agent_msg_meta, - mde.delivery_status, - mde.created_at -FROM groups g -JOIN group_profiles gp ON gp.group_profile_id == g.group_profile_id -JOIN ( - SELECT group_id, chat_item_id, MAX(item_ts) MaxDate - FROM chat_items - WHERE item_deleted != 1 - GROUP BY group_id, chat_item_id -) CIMaxDates ON CIMaxDates.group_id = g.group_id -LEFT JOIN chat_items ci ON ci.chat_item_id == CIMaxDates.chat_item_id - AND ci.item_ts == CIMaxDates.MaxDate -LEFT JOIN group_members ON gm.group_member_id == ci.group_member_id -JOIN contact_profiles cp ON cp.contact_profile_id == gm.contact_profile_id -JOIN messages m ON m.message_id == ci.created_by_msg_id -JOIN msg_deliveries md ON md.message_id = m.message_id -JOIN ( - SELECT msg_delivery_id, MAX(created_at) MaxDate - FROM msg_delivery_events - GROUP BY msg_delivery_id -) MDEMaxDates ON MDEMaxDates.msg_delivery_id = md.msg_delivery_id -JOIN msg_delivery_events mde ON mde.msg_delivery_id = MDEMaxDates.msg_delivery_id - AND mde.created_at = MDEMaxDates.MaxDate -WHERE c.user_id = ? -ORDER BY ci.item_ts DESC diff --git a/src/Simplex/Chat/Migrations/chat_item_queries/getChatItemsMixed.sql b/src/Simplex/Chat/Migrations/chat_item_queries/getChatItemsMixed.sql deleted file mode 100644 index f537cee929..0000000000 --- a/src/Simplex/Chat/Migrations/chat_item_queries/getChatItemsMixed.sql +++ /dev/null @@ -1,44 +0,0 @@ -SELECT - c.contact_id, - cp.display_name, - cp.full_name, - cp.properties, - g.group_id, - gp.display_name, - gp.full_name, - gp.properties, - gm.group_member_id, - gmp.display_name, - gmp.full_name, - gmp.properties, - ci.chat_item_id, - ci.chat_msg_id, - ci.created_by_msg_id, - ci.item_sent, - ci.item_ts, - ci.item_deleted, - ci.item_text, - ci.item_content, - md.msg_delivery_id, - md.chat_ts, - md.agent_msg_meta, - mde.delivery_status, - mde.created_at -FROM chat_items ci -LEFT JOIN contacts c ON c.contact_id == ci.contact_id -JOIN contact_profiles cp ON cp.contact_profile_id == c.contact_profile_id -LEFT JOIN groups g ON g.group_id = ci.group_id -JOIN group_profiles gp ON gp.group_profile_id == g.group_profile_id -LEFT JOIN group_members ON gm.group_member_id == ci.group_member_id -JOIN contact_profiles gmp ON gmp.contact_profile_id == gm.contact_profile_id -JOIN messages m ON m.message_id == ci.created_by_msg_id -JOIN msg_deliveries md ON md.message_id = m.message_id -JOIN ( - SELECT msg_delivery_id, MAX(created_at) MaxDate - FROM msg_delivery_events - GROUP BY msg_delivery_id -) MDEMaxDates ON MDEMaxDates.msg_delivery_id = md.msg_delivery_id -JOIN msg_delivery_events mde ON mde.msg_delivery_id = MDEMaxDates.msg_delivery_id - AND mde.created_at = MDEMaxDates.MaxDate -WHERE ci.user_id = ? -ORDER BY ci.item_ts DESC diff --git a/src/Simplex/Chat/Migrations/chat_item_queries/getDirectChatItemList.sql b/src/Simplex/Chat/Migrations/chat_item_queries/getDirectChatItemList.sql deleted file mode 100644 index eb6426ba96..0000000000 --- a/src/Simplex/Chat/Migrations/chat_item_queries/getDirectChatItemList.sql +++ /dev/null @@ -1,32 +0,0 @@ -SELECT - c.contact_id, - cp.display_name, - cp.full_name, - cp.properties, - ci.chat_item_id, - ci.chat_msg_id, - ci.created_by_msg_id, - ci.item_sent, - ci.item_ts, - ci.item_deleted, - ci.item_text, - ci.item_content, - md.msg_delivery_id, - md.chat_ts, - md.agent_msg_meta, - mde.delivery_status, - mde.created_at -FROM contacts c -JOIN contact_profiles cp ON cp.contact_profile_id == c.contact_profile_id -LEFT JOIN chat_items ci ON ci.contact_id == c.contact_id -JOIN messages m ON m.message_id == ci.created_by_msg_id -JOIN msg_deliveries md ON md.message_id = m.message_id -JOIN ( - SELECT msg_delivery_id, MAX(created_at) MaxDate - FROM msg_delivery_events - GROUP BY msg_delivery_id -) MDEMaxDates ON MDEMaxDates.msg_delivery_id = md.msg_delivery_id -JOIN msg_delivery_events mde ON mde.msg_delivery_id = MDEMaxDates.msg_delivery_id - AND mde.created_at = MDEMaxDates.MaxDate -WHERE c.user_id = ? AND c.contact_id = ? -ORDER BY ci.item_ts DESC diff --git a/src/Simplex/Chat/Migrations/chat_item_queries/getGroupChatItemList.sql b/src/Simplex/Chat/Migrations/chat_item_queries/getGroupChatItemList.sql deleted file mode 100644 index 5e35a9b095..0000000000 --- a/src/Simplex/Chat/Migrations/chat_item_queries/getGroupChatItemList.sql +++ /dev/null @@ -1,38 +0,0 @@ -SELECT - g.group_id, - gp.display_name, - gp.full_name, - gp.properties, - gm.group_member_id, - cp.display_name, - cp.full_name, - cp.properties, - ci.chat_item_id, - ci.chat_msg_id, - ci.created_by_msg_id, - ci.item_sent, - ci.item_ts, - ci.item_deleted, - ci.item_text, - ci.item_content, - md.msg_delivery_id, - md.chat_ts, - md.agent_msg_meta, - mde.delivery_status, - mde.created_at -FROM groups g -JOIN group_profiles gp ON gp.group_profile_id == g.group_profile_id -LEFT JOIN chat_items ci ON ci.group_id == g.group_id -LEFT JOIN group_members ON gm.group_member_id == ci.group_member_id -JOIN contact_profiles cp ON cp.contact_profile_id == gm.contact_profile_id -JOIN messages m ON m.message_id == ci.created_by_msg_id -JOIN msg_deliveries md ON md.message_id = m.message_id -JOIN ( - SELECT msg_delivery_id, MAX(created_at) MaxDate - FROM msg_delivery_events - GROUP BY msg_delivery_id -) MDEMaxDates ON MDEMaxDates.msg_delivery_id = md.msg_delivery_id -JOIN msg_delivery_events mde ON mde.msg_delivery_id = MDEMaxDates.msg_delivery_id - AND mde.created_at = MDEMaxDates.MaxDate -WHERE g.user_id = ? AND g.group_id = ? -ORDER BY ci.item_ts DESC diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 8e3f8a776d..8d16239848 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -9,7 +9,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} module Simplex.Chat.Protocol where @@ -26,6 +25,7 @@ import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) import GHC.Generics (Generic) import Simplex.Chat.Types +import Simplex.Chat.Util (eitherToMaybe) import Simplex.Messaging.Agent.Store.SQLite (fromTextField_) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Util ((<$?>)) @@ -240,7 +240,7 @@ toCMEventTag = \case XOk -> XOk_ cmEventTagT :: Text -> Maybe CMEventTag -cmEventTagT = either (const Nothing) Just . strDecode . encodeUtf8 +cmEventTagT = eitherToMaybe . strDecode . encodeUtf8 serializeCMEventTag :: CMEventTag -> Text serializeCMEventTag = decodeLatin1 . strEncode diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index a5e1fc1238..9b11ca3a91 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -106,6 +106,7 @@ module Simplex.Chat.Store createNewChatItem, getChatPreviews, getDirectChat, + getGroupChat, ) where @@ -124,11 +125,13 @@ import Data.Either (rights) import Data.Function (on) import Data.Functor (($>)) import Data.Int (Int64) -import Data.List (find, sortBy) +import Data.List (find, sortBy, sortOn) import Data.Maybe (listToMaybe) +import Data.Ord (Down (..)) import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Clock (UTCTime, getCurrentTime) +import Data.Time (fromGregorian, secondsToDiffTime) +import Data.Time.Clock (UTCTime (UTCTime), getCurrentTime) import Data.Time.LocalTime (TimeZone, getCurrentTimeZone) import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError, (:.) (..)) import qualified Database.SQLite.Simple as DB @@ -140,7 +143,7 @@ import Simplex.Chat.Migrations.M20220122_pending_group_messages import Simplex.Chat.Migrations.M20220125_chat_items import Simplex.Chat.Protocol import Simplex.Chat.Types -import Simplex.Chat.Util (singleFieldJSON) +import Simplex.Chat.Util (eitherToMaybe, singleFieldJSON) import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..)) import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, firstRow, withTransaction) import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) @@ -405,7 +408,7 @@ getContact_ db userId localDisplayName = do toContact [(contactId, displayName, fullName, viaGroup)] = let profile = Profile {displayName, fullName} in Right Contact {contactId, localDisplayName, profile, activeConn = undefined, viaGroup} - toContact _ = Left $ SEContactNotFound localDisplayName + toContact _ = Left $ SEContactNotFoundByName localDisplayName connection :: [ConnectionRow] -> Either StoreError Connection connection (connRow : _) = Right $ toConnection connRow connection _ = Left $ SEContactNotReady localDisplayName @@ -433,7 +436,7 @@ getUserContactLinkConnections st userId = SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at FROM connections c - JOIN user_contact_links uc ON c.user_contact_link_id == uc.user_contact_link_id + JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id WHERE c.user_id = :user_id AND uc.user_id = :user_id AND uc.local_display_name = '' @@ -627,14 +630,14 @@ getContactConnections st userId displayName = SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at FROM connections c - JOIN contacts cs ON c.contact_id == cs.contact_id + JOIN contacts cs ON c.contact_id = cs.contact_id WHERE c.user_id = :user_id AND cs.user_id = :user_id - AND cs.local_display_name == :display_name + AND cs.local_display_name = :display_name |] [":user_id" := userId, ":display_name" := displayName] where - connections [] = Left $ SEContactNotFound displayName + connections [] = Left $ SEContactNotFoundByName displayName connections rows = Right $ map toConnection rows type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime) @@ -709,9 +712,7 @@ matchReceivedProbe st userId _from@Contact {contactId} (Probe probe) = DB.execute db "INSERT INTO received_probes (contact_id, probe, probe_hash, user_id) VALUES (?,?,?,?)" (contactId, probe, probeHash, userId) case contactNames of [] -> pure Nothing - cName : _ -> - either (const Nothing) Just - <$> runExceptT (getContact_ db userId cName) + cName : _ -> eitherToMaybe <$> runExceptT (getContact_ db userId cName) matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ProbeHash -> m (Maybe (Contact, Probe)) matchReceivedProbeHash st userId _from@Contact {contactId} (ProbeHash probeHash) = @@ -750,9 +751,7 @@ matchSentProbe st userId _from@Contact {contactId} (Probe probe) = (userId, probe, contactId) case contactNames of [] -> pure Nothing - cName : _ -> - either (const Nothing) Just - <$> runExceptT (getContact_ db userId cName) + cName : _ -> eitherToMaybe <$> runExceptT (getContact_ db userId cName) mergeContactRecords :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Contact -> m () mergeContactRecords st userId Contact {contactId = toContactId} Contact {contactId = fromContactId, localDisplayName} = @@ -834,13 +833,17 @@ getConnectionEntity st User {userId, userContactId} agentConnId = [sql| SELECT -- GroupInfo - g.group_id, g.local_display_name, gp.display_name, gp.full_name, + g.group_id, g.local_display_name, + -- GroupInfo {groupProfile} + gp.display_name, gp.full_name, + -- GroupInfo {membership} + mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, + mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, + -- GroupInfo {membership = GroupMember {memberProfile}} + pu.display_name, pu.full_name, -- from GroupMember m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, - m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, - -- user membership - mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, - mu.invited_by, mu.local_display_name, mu.contact_id, pu.display_name, pu.full_name + m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id JOIN groups g ON g.group_id = m.group_id @@ -850,8 +853,8 @@ getConnectionEntity st User {userId, userContactId} agentConnId = WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ? |] (groupMemberId, userId, userContactId) - toGroupAndMember :: Connection -> (Int64, GroupName, GroupName, Text) :. GroupMemberRow :. GroupMemberRow -> (GroupInfo, GroupMember) - toGroupAndMember c ((groupId, localDisplayName, displayName, fullName) :. memberRow :. userMemberRow) = + toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember) + toGroupAndMember c (((groupId, localDisplayName, displayName, fullName) :. userMemberRow) :. memberRow) = let member = toGroupMember userContactId memberRow membership = toGroupMember userContactId userMemberRow in ( GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName}, membership}, @@ -917,7 +920,7 @@ createNewGroup st gVar user groupProfile = -- | creates a new group record for the group the current user was invited to, or returns an existing one createGroupInvitation :: StoreMonad m => SQLiteStore -> User -> Contact -> GroupInvitation -> m GroupInfo -createGroupInvitation st user@User {userId} contact GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} = +createGroupInvitation st user@User {userId} contact@Contact {contactId} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} = liftIOEither . withTransaction st $ \db -> do getGroupInvitationLdn_ db >>= \case Nothing -> createGroupInvitation_ db @@ -937,7 +940,7 @@ createGroupInvitation st user@User {userId} contact GroupInvitation {fromMember, DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, connRequest, userId) groupId <- insertedRowId db _ <- createContactMember_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown - membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact $ contactId contact) + membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) pure $ GroupInfo {groupId, localDisplayName, groupProfile, membership} -- TODO return the last connection that is ready, not any last connection @@ -990,24 +993,33 @@ getGroupInfo st user gName = liftIOEither . withTransaction st $ \db -> getGroup getGroupInfo_ :: DB.Connection -> User -> GroupName -> IO (Either StoreError GroupInfo) getGroupInfo_ db User {userId, userContactId} gName = - firstRow (toGroupInfo userContactId) (SEGroupNotFound gName) $ + firstRow (toGroupInfo userContactId) (SEGroupNotFoundByName gName) $ DB.query db [sql| - SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, - m.group_member_id, g.group_id, m.member_id, m.member_role, m.member_category, m.member_status, - m.invited_by, m.local_display_name, m.contact_id, mp.display_name, mp.full_name + SELECT + -- GroupInfo + g.group_id, g.local_display_name, + -- GroupInfo {groupProfile} + gp.display_name, gp.full_name, + -- GroupInfo {membership} + mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, + mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, + -- GroupInfo {membership = GroupMember {memberProfile}} + pu.display_name, pu.full_name FROM groups g - JOIN group_profiles gp USING (group_profile_id) - JOIN group_members m USING (group_id) - JOIN contact_profiles mp USING (contact_profile_id) - WHERE g.local_display_name = ? AND g.user_id = ? AND m.contact_id = ? + 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 = mu.contact_profile_id + WHERE g.local_display_name = ? AND g.user_id = ? AND mu.contact_id = ? |] (gName, userId, userContactId) -toGroupInfo :: Int64 -> (Int64, GroupName, GroupName, Text) :. GroupMemberRow -> GroupInfo -toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName) :. memberRow) = - let membership = toGroupMember userContactId memberRow +type GroupInfoRow = (Int64, GroupName, GroupName, Text) :. GroupMemberRow + +toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo +toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName) :. userMemberRow) = + let membership = toGroupMember userContactId userMemberRow in GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName}, membership} getGroupMembers :: MonadUnliftIO m => SQLiteStore -> User -> GroupInfo -> m [GroupMember] @@ -1054,7 +1066,7 @@ getGroupInvitation st user localDisplayName = where getConnRec_ :: DB.Connection -> User -> ExceptT StoreError IO (Maybe ConnReqInvitation) getConnRec_ db User {userId} = ExceptT $ do - firstRow fromOnly (SEGroupNotFound localDisplayName) $ + firstRow fromOnly (SEGroupNotFoundByName localDisplayName) $ DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.local_display_name = ? AND g.user_id = ?" (localDisplayName, userId) findFromContact :: InvitedBy -> [GroupMember] -> Maybe GroupMember findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId) @@ -1062,6 +1074,8 @@ getGroupInvitation st user localDisplayName = type GroupMemberRow = (Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text) +type MaybeGroupMemberRow = (Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Int64, Maybe ContactName, Maybe Int64, Maybe ContactName, Maybe Text) + toGroupMember :: Int64 -> GroupMemberRow -> GroupMember toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, localDisplayName, memberContactId, displayName, fullName) = let memberProfile = Profile {displayName, fullName} @@ -1069,6 +1083,11 @@ toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, membe activeConn = Nothing in GroupMember {..} +toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember +toMaybeGroupMember userContactId (Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus, invitedById, Just localDisplayName, memberContactId, Just displayName, Just fullName) = + Just $ toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, localDisplayName, memberContactId, displayName, fullName) +toMaybeGroupMember _ _ = Nothing + createContactMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> m GroupMember createContactMember st gVar user groupId contact memberRole agentConnId connRequest = liftIOEither . withTransaction st $ \db -> @@ -1355,15 +1374,19 @@ getViaGroupMember st User {userId, userContactId} Contact {contactId} = [sql| SELECT -- GroupInfo - g.group_id, g.local_display_name, gp.display_name, gp.full_name, + g.group_id, g.local_display_name, + -- GroupInfo {groupProfile} + gp.display_name, gp.full_name, + -- GroupInfo {membership} + mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, + mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, + -- GroupInfo {membership = GroupMember {memberProfile}} + pu.display_name, pu.full_name, -- via GroupMember m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, - c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, - -- user membership - mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, - mu.invited_by, mu.local_display_name, mu.contact_id, pu.display_name, pu.full_name + c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at FROM group_members m JOIN contacts ct ON ct.contact_id = m.contact_id JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id @@ -1380,8 +1403,8 @@ getViaGroupMember st User {userId, userContactId} Contact {contactId} = |] (userId, contactId, userContactId) where - toGroupAndMember :: [(Int64, GroupName, GroupName, Text) :. GroupMemberRow :. MaybeConnectionRow :. GroupMemberRow] -> Maybe (GroupInfo, GroupMember) - toGroupAndMember [(groupId, localDisplayName, displayName, fullName) :. memberRow :. connRow :. userMemberRow] = + toGroupAndMember :: [GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow] -> Maybe (GroupInfo, GroupMember) + toGroupAndMember [((groupId, localDisplayName, displayName, fullName) :. userMemberRow) :. memberRow :. connRow] = let member = toGroupMember userContactId memberRow membership = toGroupMember userContactId userMemberRow in Just @@ -1767,7 +1790,7 @@ getMsgDeliveryId_ db connId agentMsgId = [sql| SELECT msg_delivery_id FROM msg_deliveries m - WHERE m.connection_id = ? AND m.agent_msg_id == ? + WHERE m.connection_id = ? AND m.agent_msg_id = ? LIMIT 1; |] (connId, agentMsgId) @@ -1845,7 +1868,11 @@ getChatPreviews st user = liftIO . withTransaction st $ \db -> do directChatPreviews <- getDirectChatPreviews_ db user groupChatPreviews <- getGroupChatPreviews_ db user - pure $ directChatPreviews <> groupChatPreviews + 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 getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChatPreview] getDirectChatPreviews_ db User {userId} = do @@ -1862,7 +1889,7 @@ getDirectChatPreviews_ db User {userId} = do -- Contact {activeConn} c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, - -- CChatItem 'CTDirect + -- ChatItem ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at FROM contacts ct JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id @@ -1873,10 +1900,10 @@ getDirectChatPreviews_ db User {userId} = do WHERE item_deleted != 1 GROUP BY contact_id ) CIMaxDates ON CIMaxDates.contact_id = c.contact_id - LEFT JOIN chat_items ci ON ci.contact_id == CIMaxDates.contact_id - AND ci.item_ts == CIMaxDates.MaxDate + LEFT JOIN chat_items ci ON ci.contact_id = CIMaxDates.contact_id + AND ci.item_ts = CIMaxDates.MaxDate WHERE ct.user_id = ? - ORDER BY ci.item_ts ASC + ORDER BY ci.item_ts DESC |] (Only userId) where @@ -1887,8 +1914,9 @@ getDirectChatPreviews_ db User {userId} = do in AChatPreview SCTDirect (DirectChat contact) ci_ getGroupChatPreviews_ :: DB.Connection -> User -> IO [AChatPreview] -getGroupChatPreviews_ db User {userId, userContactId} = - map toGroupChatPreview +getGroupChatPreviews_ db User {userId, userContactId} = do + tz <- getCurrentTimeZone + map (toGroupChatPreview tz) <$> DB.query db [sql| @@ -1898,38 +1926,57 @@ getGroupChatPreviews_ db User {userId, userContactId} = -- GroupInfo {groupProfile} gp.display_name, gp.full_name, -- GroupInfo {membership} - mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, - mu.invited_by, mu.local_display_name, mu.contact_id, + mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, + mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, -- GroupInfo {membership = GroupMember {memberProfile}} - pu.display_name, pu.full_name + pu.display_name, pu.full_name, + -- ChatItem + ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at, + -- GroupMember + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, + m.member_status, m.invited_by, m.local_display_name, m.contact_id, + -- GroupMember {memberProfile} + p.display_name, p.full_name FROM groups g - JOIN group_profiles gp ON gp.group_profile_id == g.group_profile_id - JOIN group_members mu ON g.group_id = mu.group_id + 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 = mu.contact_profile_id + LEFT JOIN ( + SELECT group_id, MAX(item_ts) MaxDate + FROM chat_items + WHERE item_deleted != 1 + GROUP BY group_id + ) GIMaxDates ON GIMaxDates.group_id = g.group_id + LEFT JOIN chat_items ci ON ci.group_id = GIMaxDates.group_id + AND ci.item_ts = GIMaxDates.MaxDate + LEFT JOIN group_members m ON m.group_member_id = ci.group_member_id + LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id WHERE g.user_id = ? AND mu.contact_id = ? + ORDER BY ci.item_ts DESC |] (userId, userContactId) where - toGroupChatPreview :: (Int64, GroupName, GroupName, Text) :. GroupMemberRow -> AChatPreview - toGroupChatPreview ((groupId, localDisplayName, displayName, fullName) :. userMemberRow) = + toGroupChatPreview :: TimeZone -> GroupInfoRow :. MaybeGroupChatItemRow -> AChatPreview + toGroupChatPreview tz (((groupId, localDisplayName, displayName, fullName) :. userMemberRow) :. ciRow_) = let membership = toGroupMember userContactId userMemberRow groupInfo = GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName}, membership} - in AChatPreview SCTGroup (GroupChat groupInfo) Nothing + ci_ = toMaybeGroupChatItem tz userContactId ciRow_ + in AChatPreview SCTGroup (GroupChat groupInfo) ci_ getDirectChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Chat 'CTDirect) getDirectChat st user contactId = liftIOEither . withTransaction st $ \db -> runExceptT $ do - contact <- getContact_' db user contactId + contact <- ExceptT $ getContact_' db user contactId chatItems <- liftIO $ getDirectChatItems_ db user contactId pure $ Chat (DirectChat contact) chatItems -getContact_' :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Contact +-- TODO reuse in contact queries +getContact_' :: DB.Connection -> User -> Int64 -> IO (Either StoreError Contact) getContact_' db User {userId} contactId = - ExceptT $ - toContact - <$> DB.query - db - [sql| + firstRow toContact' (SEContactNotFound contactId) $ + DB.query + db + [sql| SELECT -- Contact ct.contact_id, ct.local_display_name, ct.via_group, @@ -1943,11 +1990,7 @@ getContact_' db User {userId} contactId = JOIN connections c ON c.contact_id = ct.contact_id WHERE ct.user_id = ? AND ct.contact_id = ? |] - (userId, contactId) - where - toContact :: [ContactRow] -> Either StoreError Contact - toContact (contactRow : _) = Right $ toContact' contactRow - toContact _ = Left $ SEContactNotFoundById contactId + (userId, contactId) getDirectChatItems_ :: DB.Connection -> User -> Int64 -> IO [CChatItem 'CTDirect] getDirectChatItems_ db User {userId} contactId = do @@ -1963,6 +2006,61 @@ getDirectChatItems_ db User {userId} contactId = do |] (userId, contactId) +getGroupChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Chat 'CTGroup) +getGroupChat st user groupId = + liftIOEither . withTransaction st $ \db -> runExceptT $ do + groupInfo <- ExceptT $ getGroupInfo_' db user groupId + chatItems <- ExceptT $ getGroupChatItems_ db user groupId + pure $ Chat (GroupChat groupInfo) chatItems + +-- TODO reuse in group queries +getGroupInfo_' :: DB.Connection -> User -> Int64 -> IO (Either StoreError GroupInfo) +getGroupInfo_' db User {userId, userContactId} groupId = + firstRow (toGroupInfo userContactId) (SEGroupNotFound groupId) $ + DB.query + db + [sql| + SELECT + -- GroupInfo + g.group_id, g.local_display_name, + -- GroupInfo {groupProfile} + gp.display_name, gp.full_name, + -- GroupInfo {membership} + mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, + mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, + -- GroupInfo {membership = GroupMember {memberProfile}} + pu.display_name, pu.full_name + 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 = mu.contact_profile_id + WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ? + |] + (groupId, userId, userContactId) + +getGroupChatItems_ :: DB.Connection -> User -> Int64 -> IO (Either StoreError [CChatItem 'CTGroup]) +getGroupChatItems_ db User {userId, userContactId} groupId = do + tz <- getCurrentTimeZone + mapM (toGroupChatItem tz userContactId) + <$> DB.query + db + [sql| + SELECT + -- ChatItem + ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at, + -- GroupMember + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, + m.member_status, m.invited_by, m.local_display_name, m.contact_id, + -- GroupMember {memberProfile} + p.display_name, p.full_name + FROM chat_items ci + LEFT JOIN group_members m ON m.group_member_id = ci.group_member_id + LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id + WHERE ci.user_id = ? AND ci.group_id = ? + ORDER BY ci.item_ts ASC + |] + (userId, groupId) + type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, UTCTime) type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe UTCTime) @@ -1979,25 +2077,23 @@ toMaybeDirectChatItem tz (Just itemId, Just itemTs, Just itemContent, Just itemT Just $ toDirectChatItem tz (itemId, itemTs, itemContent, itemText, createdAt) toMaybeDirectChatItem _ _ = Nothing --- getGroupChatItemList :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> m ChatItemList --- getGroupChatItemList st userId groupId = --- liftIO . withTransaction st $ \db -> --- DB.query --- db --- [sql| --- ... --- |] --- (userId, groupId) +type GroupChatItemRow = ChatItemRow :. MaybeGroupMemberRow --- getChatItemsMixed :: MonadUnliftIO m => SQLiteStore -> UserId -> m [AnyChatItem] --- getChatItemsMixed st userId = --- liftIO . withTransaction st $ \db -> --- DB.query --- db --- [sql| --- ... --- |] --- (Only userId) +type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow + +toGroupChatItem :: TimeZone -> Int64 -> GroupChatItemRow -> Either StoreError (CChatItem 'CTGroup) +toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, createdAt) :. memberRow_) = + let ciMeta = mkCIMeta itemId itemText tz itemTs createdAt + member_ = toMaybeGroupMember userContactId memberRow_ + in case (itemContent, member_) of + (ACIContent d@SMDSnd ciContent, Nothing) -> Right $ CChatItem d (ChatItem CIGroupSnd ciMeta ciContent) + (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 -- | Saves unique local display name based on passed displayName, suffixed with _N if required. -- This function should be called inside transaction. @@ -2056,13 +2152,14 @@ randomBytes gVar n = B64.encode <$> (atomically . stateTVar gVar $ randomBytesGe data StoreError = SEDuplicateName - | SEContactNotFoundById Int64 - | SEContactNotFound {contactName :: ContactName} + | SEContactNotFound {contactId :: Int64} + | SEContactNotFoundByName {contactName :: ContactName} | SEContactNotReady {contactName :: ContactName} | SEDuplicateContactLink | SEUserContactLinkNotFound | SEContactRequestNotFound {contactName :: ContactName} - | SEGroupNotFound {groupName :: GroupName} + | SEGroupNotFound {groupId :: Int64} + | SEGroupNotFoundByName {groupName :: GroupName} | SEGroupWithoutUser | SEDuplicateGroupMember | SEGroupAlreadyJoined @@ -2077,6 +2174,7 @@ data StoreError | SEUniqueID | SEInternal {message :: String} | SENoMsgDelivery {connId :: Int64, agentMsgId :: AgentMsgId} + | SEBadChatItem {itemId :: Int64} deriving (Show, Exception, Generic) instance ToJSON StoreError where diff --git a/src/Simplex/Chat/Util.hs b/src/Simplex/Chat/Util.hs index 7be20f54e0..f4663879bb 100644 --- a/src/Simplex/Chat/Util.hs +++ b/src/Simplex/Chat/Util.hs @@ -34,3 +34,6 @@ singleFieldJSON tagModifier = J.sumEncoding = J.ObjectWithSingleField, J.omitNothingFields = True } + +eitherToMaybe :: Either a b -> Maybe b +eitherToMaybe = either (const Nothing) Just diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 9923c3a39d..5eae8f13ed 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -36,6 +36,7 @@ responseToView :: String -> ChatResponse -> [StyledString] responseToView cmd = \case CRApiChats chats -> api [sShow chats] CRApiDirectChat chat -> api [sShow chat] + CRApiGroupChat gChat -> api [sShow gChat] CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item CRCmdAccepted _ -> r [] CRChatHelp section -> case section of @@ -470,9 +471,9 @@ viewChatError = \case -- e -> ["chat error: " <> sShow e] ChatErrorStore err -> case err of SEDuplicateName -> ["this display name is already used by user, contact or group"] - SEContactNotFound c -> ["no contact " <> ttyContact c] + SEContactNotFoundByName c -> ["no contact " <> ttyContact c] SEContactNotReady c -> ["contact " <> ttyContact c <> " is not active yet"] - SEGroupNotFound g -> ["no group " <> ttyGroup g] + SEGroupNotFoundByName g -> ["no group " <> ttyGroup g] SEGroupAlreadyJoined -> ["you already joined this group"] SEFileNotFound fileId -> fileNotFound fileId SESndFileNotFound fileId -> fileNotFound fileId