diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 5ae2477635..fe133fd6a1 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -126,9 +126,21 @@ processChatCommand :: forall m. ChatMonad m => User -> ChatCommand -> m ChatResp 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 -> CRApiGroupChat <$> withStore (\st -> getGroupChat st user cId) + CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st userId cId) + CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId) APIGetChatItems _count -> pure $ CRChatError ChatErrorNotImplemented + APISendMessage cType chatId mc -> case cType of + CTDirect -> do + ct@Contact {localDisplayName = c} <- withStore $ \st -> getContact st userId chatId + ci <- sendDirectChatItem userId ct (XMsgNew mc) (CISndMsgContent mc) + setActive $ ActiveC c + pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci + CTGroup -> do + group@(Group gInfo@GroupInfo {localDisplayName = gName, membership} _) <- withStore $ \st -> getGroup st user chatId + unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved + ci <- sendGroupChatItem userId group (XMsgNew mc) (CISndMsgContent mc) + setActive $ ActiveG gName + pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci ChatHelp section -> pure $ CRChatHelp section Welcome -> pure $ CRWelcome user AddContact -> procCmd $ do @@ -183,17 +195,15 @@ processChatCommand user@User {userId, profile} = \case withAgent $ \a -> rejectContact a agentContactConnId agentInvitationId pure $ CRContactRequestRejected cName SendMessage cName msg -> do - contact <- withStore $ \st -> getContact st userId cName + contactId <- withStore $ \st -> getContactIdByName st userId cName let mc = MCText $ safeDecodeUtf8 msg - ci <- sendDirectChatItem userId contact (XMsgNew mc) (CISndMsgContent mc) - setActive $ ActiveC cName - pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci + processChatCommand user $ APISendMessage CTDirect contactId mc NewGroup gProfile -> do gVar <- asks idsDrg CRGroupCreated <$> withStore (\st -> createNewGroup st gVar user gProfile) AddMember gName cName memRole -> do -- TODO for large groups: no need to load all members to determine if contact is a member - (group, contact) <- withStore $ \st -> (,) <$> getGroup st user gName <*> getContact st userId cName + (group, contact) <- withStore $ \st -> (,) <$> getGroupByName st user gName <*> getContactByName st userId cName let Group gInfo@GroupInfo {groupId, groupProfile, membership} members = group GroupMember {memberRole = userRole, memberId = userMemberId} = membership when (userRole < GRAdmin || userRole < memRole) $ throwChatError CEGroupUserRole @@ -227,7 +237,7 @@ processChatCommand user@User {userId, profile} = \case pure $ CRUserAcceptedGroupSent g MemberRole _gName _cName _mRole -> throwChatError $ CECommandError "unsupported" RemoveMember gName cName -> do - Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroup st user gName + Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroupByName st user gName case find ((== cName) . (localDisplayName :: GroupMember -> ContactName)) members of Nothing -> throwChatError $ CEGroupMemberNotFound cName Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus} -> do @@ -239,14 +249,14 @@ processChatCommand user@User {userId, profile} = \case withStore $ \st -> updateGroupMemberStatus st userId m GSMemRemoved pure $ CRUserDeletedMember gInfo m LeaveGroup gName -> do - Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroup st user gName + Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroupByName st user gName procCmd $ do void $ sendGroupMessage members XGrpLeave mapM_ deleteMemberConnection members withStore $ \st -> updateGroupMemberStatus st userId membership GSMemLeft pure $ CRLeftMemberUser gInfo DeleteGroup gName -> do - g@(Group gInfo@GroupInfo {membership} members) <- withStore $ \st -> getGroup st user gName + g@(Group gInfo@GroupInfo {membership} members) <- withStore $ \st -> getGroupByName st user gName let s = memberStatus membership canDelete = memberRole (membership :: GroupMember) == GROwner @@ -257,18 +267,15 @@ processChatCommand user@User {userId, profile} = \case mapM_ deleteMemberConnection members withStore $ \st -> deleteGroup st user g pure $ CRGroupDeletedUser gInfo - ListMembers gName -> CRGroupMembers <$> withStore (\st -> getGroup st user gName) + ListMembers gName -> CRGroupMembers <$> withStore (\st -> getGroupByName st user gName) ListGroups -> CRGroupsList <$> withStore (`getUserGroupDetails` user) SendGroupMessage gName msg -> do - group@(Group gInfo@GroupInfo {membership} _) <- withStore $ \st -> getGroup st user gName - unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved + groupId <- withStore $ \st -> getGroupIdByName st user gName let mc = MCText $ safeDecodeUtf8 msg - ci <- sendGroupChatItem userId group (XMsgNew mc) (CISndMsgContent mc) - setActive $ ActiveG gName - pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci + processChatCommand user $ APISendMessage CTGroup groupId mc SendFile cName f -> do (fileSize, chSize) <- checkSndFile f - contact <- withStore $ \st -> getContact st userId cName + contact <- withStore $ \st -> getContactByName st userId cName (agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation) let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq} SndFileTransfer {fileId} <- withStore $ \st -> @@ -279,7 +286,7 @@ processChatCommand user@User {userId, profile} = \case pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci SendGroupFile gName f -> do (fileSize, chSize) <- checkSndFile f - Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroup st user gName + Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroupByName st user gName unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved let fileName = takeFileName f ms <- forM (filter memberActive members) $ \m -> do @@ -1296,9 +1303,10 @@ withStore action = chatCommandP :: Parser ChatCommand chatCommandP = - "/api/v1/chats" $> APIGetChats - <|> "/api/v1/chat/" *> (APIGetChat <$> ("direct/" $> CTDirect <|> "group/" $> CTGroup) <*> A.decimal) - <|> "/api/v1/chat/items?count=" *> (APIGetChatItems <$> A.decimal) + "/get chats" $> APIGetChats + <|> "/get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal) + <|> "/get chatItems count=" *> (APIGetChatItems <$> A.decimal) + <|> "/send msg " *> (APISendMessage <$> chatTypeP <*> A.decimal <* A.space <*> msgContentP) <|> ("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles <|> ("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups <|> ("/help address" <|> "/ha") $> ChatHelp HSMyAddress @@ -1316,7 +1324,7 @@ chatCommandP = <|> ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)) <|> ("/connect" <|> "/c") $> AddContact <|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName) - <|> A.char '@' *> (SendMessage <$> displayName <*> (A.space *> A.takeByteString)) + <|> A.char '@' *> (SendMessage <$> displayName <* A.space <*> A.takeByteString) <|> ("/file #" <|> "/f #") *> (SendGroupFile <$> displayName <* A.space <*> filePath) <|> ("/file @" <|> "/file " <|> "/f @" <|> "/f ") *> (SendFile <$> displayName <* A.space <*> filePath) <|> ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (A.space *> filePath)) @@ -1335,6 +1343,8 @@ chatCommandP = <|> ("/quit" <|> "/q" <|> "/exit") $> QuitChat <|> ("/version" <|> "/v") $> ShowVersion where + chatTypeP = "@" $> CTDirect <|> "#" $> CTGroup + msgContentP = "text " *> (MCText . safeDecodeUtf8 <$> A.takeByteString) displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' ')) refChar c = c > ' ' && c /= '#' && c /= '@' userProfile = do diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index a86a943b81..9dd0aac971 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -22,6 +22,7 @@ import Data.Text (Text) import GHC.Generics (Generic) import Numeric.Natural import Simplex.Chat.Messages +import Simplex.Chat.Protocol import Simplex.Chat.Store (StoreError) import Simplex.Chat.Types import Simplex.Messaging.Agent (AgentClient) @@ -80,6 +81,7 @@ data ChatCommand = APIGetChats | APIGetChat ChatType Int64 | APIGetChatItems Int + | APISendMessage ChatType Int64 MsgContent | ChatHelp HelpSection | Welcome | AddContact @@ -116,8 +118,7 @@ data ChatCommand data ChatResponse = CRApiChats {chats :: [AChatPreview]} - | CRApiDirectChat {chat :: Chat 'CTDirect} - | CRApiGroupChat {gChat :: Chat 'CTGroup} + | CRApiChat {chat :: AChat} | CRNewChatItem {chatItem :: AChatItem} | CRCmdAccepted {corr :: CorrId} | CRChatHelp {helpSection :: HelpSection} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 0aa53ab3a8..c7b26de99f 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -153,6 +153,14 @@ 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 + +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)) diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 281b65bd7d..f867744eed 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -27,7 +27,9 @@ module Simplex.Chat.Store createDirectContact, getContactGroupNames, deleteContact, + getContactByName, getContact, + getContactIdByName, updateUserProfile, updateContactProfile, getUserContacts, @@ -50,6 +52,9 @@ module Simplex.Chat.Store createGroupInvitation, getGroup, getGroupInfo, + getGroupIdByName, + getGroupByName, + getGroupInfoByName, getGroupMembers, deleteGroup, getUserGroups, @@ -306,10 +311,6 @@ deleteContact st userId displayName = |] [":user_id" := userId, ":display_name" := displayName] -getContact :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m Contact -getContact st userId localDisplayName = - liftIOEither . withTransaction st $ \db -> runExceptT $ getContact_ db userId localDisplayName - updateUserProfile :: StoreMonad m => SQLiteStore -> User -> Profile -> m () updateUserProfile st User {userId, userContactId, localDisplayName, profile = Profile {displayName}} p'@Profile {displayName = newName} | displayName == newName = @@ -370,54 +371,27 @@ toContact' ((contactId, localDisplayName, viaGroup, displayName, fullName) :. co activeConn = toConnection connRow in Contact {contactId, localDisplayName, profile, activeConn, viaGroup} +toContactOrError :: (Int64, ContactName, Maybe Int64, ContactName, Text) :. MaybeConnectionRow -> Either StoreError Contact +toContactOrError ((contactId, localDisplayName, viaGroup, displayName, fullName) :. connRow) = + let profile = Profile {displayName, fullName} + in case toMaybeConnection connRow of + Just activeConn -> + Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup} + _ -> Left $ SEContactNotReady localDisplayName + -- TODO return the last connection that is ready, not any last connection -- requires updating connection status -getContact_ :: DB.Connection -> UserId -> ContactName -> ExceptT StoreError IO Contact -getContact_ db userId localDisplayName = do - c@Contact {contactId} <- getContactRec_ - activeConn <- getConnection_ contactId - pure $ (c :: Contact) {activeConn} - where - getContactRec_ :: ExceptT StoreError IO Contact - getContactRec_ = ExceptT $ do - toContact - <$> DB.queryNamed - db - [sql| - SELECT c.contact_id, p.display_name, p.full_name, c.via_group - FROM contacts c - JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id - WHERE c.user_id = :user_id AND c.local_display_name = :local_display_name AND c.is_user = :is_user - |] - [":user_id" := userId, ":local_display_name" := localDisplayName, ":is_user" := False] - getConnection_ :: Int64 -> ExceptT StoreError IO Connection - getConnection_ contactId = ExceptT $ do - connection - <$> DB.queryNamed - db - [sql| - 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 - WHERE c.user_id = :user_id AND c.contact_id == :contact_id - ORDER BY c.connection_id DESC - LIMIT 1 - |] - [":user_id" := userId, ":contact_id" := contactId] - toContact :: [(Int64, Text, Text, Maybe Int64)] -> Either StoreError Contact - toContact [(contactId, displayName, fullName, viaGroup)] = - let profile = Profile {displayName, fullName} - in Right Contact {contactId, localDisplayName, profile, activeConn = undefined, viaGroup} - toContact _ = Left $ SEContactNotFoundByName localDisplayName - connection :: [ConnectionRow] -> Either StoreError Connection - connection (connRow : _) = Right $ toConnection connRow - connection _ = Left $ SEContactNotReady localDisplayName +getContactByName :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m Contact +getContactByName st userId localDisplayName = + liftIOEither . withTransaction st $ \db -> runExceptT $ do + cId <- ExceptT $ getContactIdByName_ db userId localDisplayName + ExceptT $ getContact_ db userId cId getUserContacts :: MonadUnliftIO m => SQLiteStore -> User -> m [Contact] getUserContacts st User {userId} = liftIO . withTransaction st $ \db -> do - contactNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM contacts WHERE user_id = ?" (Only userId) - rights <$> mapM (runExceptT . getContact_ db userId) contactNames + contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ?" (Only userId) + rights <$> mapM (getContact_ db userId) contactIds createUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> ConnId -> ConnReqContact -> m () createUserContactLink st userId agentConnId cReq = @@ -664,12 +638,12 @@ toMaybeConnection _ = Nothing getMatchingContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [Contact] getMatchingContacts st userId Contact {contactId, profile = Profile {displayName, fullName}} = liftIO . withTransaction st $ \db -> do - contactNames <- + contactIds <- map fromOnly <$> DB.queryNamed db [sql| - SELECT ct.local_display_name + SELECT ct.contact_id FROM contacts ct JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id WHERE ct.user_id = :user_id AND ct.contact_id != :contact_id @@ -680,7 +654,7 @@ getMatchingContacts st userId Contact {contactId, profile = Profile {displayName ":display_name" := displayName, ":full_name" := fullName ] - rights <$> mapM (runExceptT . getContact_ db userId) contactNames + rights <$> mapM (getContact_ db userId) contactIds createSentProbe :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> UserId -> Contact -> m (Probe, Int64) createSentProbe st gVar userId _to@Contact {contactId} = @@ -698,21 +672,21 @@ matchReceivedProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Pro matchReceivedProbe st userId _from@Contact {contactId} (Probe probe) = liftIO . withTransaction st $ \db -> do let probeHash = C.sha256Hash probe - contactNames <- + contactIds <- map fromOnly <$> DB.query db [sql| - SELECT c.local_display_name + SELECT c.contact_id FROM contacts c JOIN received_probes r ON r.contact_id = c.contact_id WHERE c.user_id = ? AND r.probe_hash = ? AND r.probe IS NULL |] (userId, probeHash) DB.execute db "INSERT INTO received_probes (contact_id, probe, probe_hash, user_id) VALUES (?,?,?,?)" (contactId, probe, probeHash, userId) - case contactNames of + case contactIds of [] -> pure Nothing - cName : _ -> eitherToMaybe <$> runExceptT (getContact_ db userId cName) + cId : _ -> eitherToMaybe <$> getContact_ db userId cId matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ProbeHash -> m (Maybe (Contact, Probe)) matchReceivedProbeHash st userId _from@Contact {contactId} (ProbeHash probeHash) = @@ -721,7 +695,7 @@ matchReceivedProbeHash st userId _from@Contact {contactId} (ProbeHash probeHash) DB.query db [sql| - SELECT c.local_display_name, r.probe + SELECT c.contact_id, r.probe FROM contacts c JOIN received_probes r ON r.contact_id = c.contact_id WHERE c.user_id = ? AND r.probe_hash = ? AND r.probe IS NOT NULL @@ -730,28 +704,28 @@ matchReceivedProbeHash st userId _from@Contact {contactId} (ProbeHash probeHash) DB.execute db "INSERT INTO received_probes (contact_id, probe_hash, user_id) VALUES (?,?,?)" (contactId, probeHash, userId) case namesAndProbes of [] -> pure Nothing - (cName, probe) : _ -> + (cId, probe) : _ -> either (const Nothing) (Just . (,Probe probe)) - <$> runExceptT (getContact_ db userId cName) + <$> getContact_ db userId cId matchSentProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Probe -> m (Maybe Contact) matchSentProbe st userId _from@Contact {contactId} (Probe probe) = liftIO . withTransaction st $ \db -> do - contactNames <- + contactIds <- map fromOnly <$> DB.query db [sql| - SELECT c.local_display_name + SELECT c.contact_id FROM contacts c JOIN sent_probes s ON s.contact_id = c.contact_id JOIN sent_probe_hashes h ON h.sent_probe_id = s.sent_probe_id WHERE c.user_id = ? AND s.probe = ? AND h.contact_id = ? |] (userId, probe, contactId) - case contactNames of + case contactIds of [] -> pure Nothing - cName : _ -> eitherToMaybe <$> runExceptT (getContact_ db userId cName) + cId : _ -> eitherToMaybe <$> getContact_ db userId cId mergeContactRecords :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Contact -> m () mergeContactRecords st userId Contact {contactId = toContactId} Contact {contactId = fromContactId, localDisplayName} = @@ -922,15 +896,15 @@ createGroupInvitation :: StoreMonad m => SQLiteStore -> User -> Contact -> GroupInvitation -> m GroupInfo createGroupInvitation st user@User {userId} contact@Contact {contactId} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} = liftIOEither . withTransaction st $ \db -> do - getGroupInvitationLdn_ db >>= \case + getInvitationGroupId_ db >>= \case Nothing -> createGroupInvitation_ db -- TODO treat the case that the invitation details could've changed - Just localDisplayName -> getGroupInfo_ db user localDisplayName + Just gId -> getGroupInfo_ db user gId where - getGroupInvitationLdn_ :: DB.Connection -> IO (Maybe GroupName) - getGroupInvitationLdn_ db = + getInvitationGroupId_ :: DB.Connection -> IO (Maybe Int64) + getInvitationGroupId_ db = listToMaybe . map fromOnly - <$> DB.query db "SELECT local_display_name FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1;" (connRequest, userId) + <$> DB.query db "SELECT group_id FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1;" (connRequest, userId) createGroupInvitation_ :: DB.Connection -> IO (Either StoreError GroupInfo) createGroupInvitation_ db = do let GroupProfile {displayName, fullName} = groupProfile @@ -945,13 +919,19 @@ createGroupInvitation st user@User {userId} contact@Contact {contactId} GroupInv -- TODO return the last connection that is ready, not any last connection -- requires updating connection status -getGroup :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Group -getGroup st user localDisplayName = - liftIOEither . withTransaction st $ \db -> runExceptT $ getGroup_ db user localDisplayName +getGroupByName :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Group +getGroupByName st user gName = + liftIOEither . withTransaction st $ \db -> runExceptT $ do + groupId <- ExceptT $ getGroupIdByName_ db user gName + ExceptT $ getGroup_ db user groupId -getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO Group -getGroup_ db user gName = do - gInfo <- ExceptT $ getGroupInfo_ db user gName +getGroup :: StoreMonad m => SQLiteStore -> User -> Int64 -> m Group +getGroup st user groupId = + liftIOEither . withTransaction st $ \db -> getGroup_ db user groupId + +getGroup_ :: DB.Connection -> User -> Int64 -> IO (Either StoreError Group) +getGroup_ db user groupId = runExceptT $ do + gInfo <- ExceptT $ getGroupInfo_ db user groupId members <- liftIO $ getGroupMembers_ db user gInfo pure $ Group gInfo members @@ -967,8 +947,8 @@ deleteGroup st User {userId} (Group GroupInfo {groupId, localDisplayName} member getUserGroups :: MonadUnliftIO m => SQLiteStore -> User -> m [Group] getUserGroups st user@User {userId} = liftIO . withTransaction st $ \db -> do - groupNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only userId) - rights <$> mapM (runExceptT . getGroup_ db user) groupNames + groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId) + rights <$> mapM (getGroup_ db user) groupIds getUserGroupDetails :: MonadUnliftIO m => SQLiteStore -> User -> m [GroupInfo] getUserGroupDetails st User {userId, userContactId} = @@ -988,32 +968,11 @@ getUserGroupDetails st User {userId, userContactId} = |] (userId, userContactId) -getGroupInfo :: StoreMonad m => SQLiteStore -> User -> GroupName -> m GroupInfo -getGroupInfo st user gName = liftIOEither . withTransaction st $ \db -> getGroupInfo_ db user gName - -getGroupInfo_ :: DB.Connection -> User -> GroupName -> IO (Either StoreError GroupInfo) -getGroupInfo_ db User {userId, userContactId} gName = - firstRow (toGroupInfo userContactId) (SEGroupNotFoundByName gName) $ - 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.local_display_name = ? AND g.user_id = ? AND mu.contact_id = ? - |] - (gName, userId, userContactId) +getGroupInfoByName :: StoreMonad m => SQLiteStore -> User -> GroupName -> m GroupInfo +getGroupInfoByName st user gName = + liftIOEither . withTransaction st $ \db -> runExceptT $ do + gId <- ExceptT $ getGroupIdByName_ db user gName + ExceptT $ getGroupInfo_ db user gId type GroupInfoRow = (Int64, GroupName, GroupName, Text) :. GroupMemberRow @@ -1057,7 +1016,8 @@ getGroupInvitation :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Rece getGroupInvitation st user localDisplayName = liftIOEither . withTransaction st $ \db -> runExceptT $ do cReq <- getConnRec_ db user - Group groupInfo@GroupInfo {membership} members <- getGroup_ db user localDisplayName + groupId <- ExceptT $ getGroupIdByName_ db user localDisplayName + Group groupInfo@GroupInfo {membership} members <- ExceptT $ getGroup_ db user groupId when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined case (cReq, findFromContact (invitedBy membership) members) of (Just connRequest, Just fromMember) -> @@ -1883,10 +1843,8 @@ getDirectChatPreviews_ db User {userId} = do [sql| SELECT -- Contact - ct.contact_id, ct.local_display_name, ct.via_group, - -- Contact {profile} - cp.display_name, cp.full_name, - -- Contact {activeConn} + ct.contact_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, + -- Connection 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, -- ChatItem @@ -1922,20 +1880,16 @@ getGroupChatPreviews_ db User {userId, userContactId} = do [sql| SELECT -- GroupInfo - g.group_id, g.local_display_name, - -- GroupInfo {groupProfile} - gp.display_name, gp.full_name, - -- GroupInfo {membership} + g.group_id, g.local_display_name, gp.display_name, gp.full_name, + -- GroupMember - 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, -- ChatItem ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at, - -- GroupMember + -- Maybe GroupMember - sender 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 @@ -1963,37 +1917,53 @@ getGroupChatPreviews_ db User {userId, userContactId} = do ci_ = toMaybeGroupChatItem tz userContactId ciRow_ in AChatPreview SCTGroup (GroupChat groupInfo) ci_ -getDirectChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Chat 'CTDirect) -getDirectChat st user contactId = +getDirectChat :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m (Chat 'CTDirect) +getDirectChat st userId contactId = liftIOEither . withTransaction st $ \db -> runExceptT $ do - contact <- ExceptT $ getContact_' db user contactId - chatItems <- liftIO $ getDirectChatItems_ db user contactId + contact <- ExceptT $ getContact_ db userId contactId + chatItems <- liftIO $ getDirectChatItems_ db userId contactId pure $ Chat (DirectChat contact) chatItems --- TODO reuse in contact queries -getContact_' :: DB.Connection -> User -> Int64 -> IO (Either StoreError Contact) -getContact_' db User {userId} contactId = - firstRow toContact' (SEContactNotFound contactId) $ - DB.query - db - [sql| - SELECT - -- Contact - ct.contact_id, ct.local_display_name, ct.via_group, - -- Contact {profile} - cp.display_name, cp.full_name, - -- 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 - FROM contacts ct - JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id - JOIN connections c ON c.contact_id = ct.contact_id - WHERE ct.user_id = ? AND ct.contact_id = ? - |] - (userId, contactId) +getContactIdByName :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m Int64 +getContactIdByName st userId cName = + liftIOEither . withTransaction st $ \db -> getContactIdByName_ db userId cName -getDirectChatItems_ :: DB.Connection -> User -> Int64 -> IO [CChatItem 'CTDirect] -getDirectChatItems_ db User {userId} contactId = do +getContactIdByName_ :: DB.Connection -> UserId -> ContactName -> IO (Either StoreError Int64) +getContactIdByName_ db userId cName = + firstRow fromOnly (SEContactNotFoundByName cName) $ + DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND local_display_name = ?" (userId, cName) + +getContact :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m Contact +getContact st userId contactId = + liftIOEither . withTransaction st $ \db -> getContact_ db userId contactId + +-- TODO return the last connection that is ready, not any last connection +-- requires updating connection status +getContact_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError Contact) +getContact_ db userId contactId = + join + <$> firstRow + toContactOrError + (SEContactNotFound contactId) + ( DB.query + db + [sql| + SELECT + -- Contact + ct.contact_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, + -- Connection + 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 contacts ct + JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id + JOIN connections c ON c.contact_id = ct.contact_id + WHERE ct.user_id = ? AND ct.contact_id = ? + |] + (userId, contactId) + ) + +getDirectChatItems_ :: DB.Connection -> UserId -> Int64 -> IO [CChatItem 'CTDirect] +getDirectChatItems_ db userId contactId = do tz <- getCurrentTimeZone map (toDirectChatItem tz) <$> DB.query @@ -2009,26 +1979,27 @@ getDirectChatItems_ db User {userId} contactId = do 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 + 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 = +getGroupInfo :: StoreMonad m => SQLiteStore -> User -> Int64 -> m GroupInfo +getGroupInfo st user groupId = + liftIOEither . withTransaction st $ \db -> + getGroupInfo_ db user groupId + +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} + g.group_id, g.local_display_name, gp.display_name, gp.full_name, + -- GroupMember - 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 @@ -2051,7 +2022,6 @@ getGroupChatItems_ db User {userId, userContactId} groupId = do -- 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 @@ -2061,6 +2031,15 @@ getGroupChatItems_ db User {userId, userContactId} groupId = do |] (userId, groupId) +getGroupIdByName :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Int64 +getGroupIdByName st user gName = + liftIOEither . withTransaction st $ \db -> getGroupIdByName_ db user gName + +getGroupIdByName_ :: DB.Connection -> User -> GroupName -> IO (Either StoreError Int64) +getGroupIdByName_ db User {userId} gName = + firstRow fromOnly (SEGroupNotFoundByName gName) $ + DB.query db "SELECT group_id FROM groups WHERE user_id = ? AND local_display_name = ?" (userId, gName) + type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, UTCTime) type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe UTCTime) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 5eae8f13ed..7af42cd1ae 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -35,8 +35,7 @@ serializeChatResponse = unlines . map unStyle . responseToView "" responseToView :: String -> ChatResponse -> [StyledString] responseToView cmd = \case CRApiChats chats -> api [sShow chats] - CRApiDirectChat chat -> api [sShow chat] - CRApiGroupChat gChat -> api [sShow gChat] + CRApiChat chat -> api [sShow chat] CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item CRCmdAccepted _ -> r [] CRChatHelp section -> case section of