diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs index e1f5ce1ef9..9432671518 100644 --- a/src/Simplex/Chat/Bot.hs +++ b/src/Simplex/Chat/Bot.hs @@ -70,7 +70,7 @@ sendComposedMessage cc = sendComposedMessage' cc . contactId' sendComposedMessage' :: ChatController -> ContactId -> Maybe ChatItemId -> MsgContent -> IO () sendComposedMessage' cc ctId quotedItemId msgContent = do let cm = ComposedMessage {fileSource = Nothing, quotedItemId, msgContent, mentions = M.empty} - sendChatCmd cc (APISendMessages (ChatRef CTDirect ctId) False Nothing [cm]) >>= \case + sendChatCmd cc (APISendMessages (SRDirect ctId) False Nothing [cm]) >>= \case CRNewChatItems {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId r -> putStrLn $ "unexpected send message response: " <> show r diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 5e39e74da4..21bdafd9ae 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -308,7 +308,7 @@ data ChatCommand | APIGetChat ChatRef (Maybe MsgContentTag) ChatPagination (Maybe String) | APIGetChatItems ChatPagination (Maybe String) | APIGetChatItemInfo ChatRef ChatItemId - | APISendMessages {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage} + | APISendMessages {sendRef :: SendRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage} | APICreateChatTag ChatTagData | APISetChatTags ChatRef (Maybe (NonEmpty ChatTagId)) | APIDeleteChatTag ChatTagId @@ -902,6 +902,17 @@ logResponseToFile = \case CRMessageError {} -> True _ -> False +-- (Maybe GroupMemberId) can later be changed to GroupSndScope = GSSAll | GSSAdmins | GSSMember GroupMemberId +data SendRef + = SRDirect ContactId + | SRGroup GroupId (Maybe GroupMemberId) + deriving (Eq, Show) + +sendToChatRef :: SendRef -> ChatRef +sendToChatRef = \case + SRDirect cId -> ChatRef CTDirect cId + SRGroup gId _ -> ChatRef CTGroup gId + data ChatPagination = CPLast Int | CPAfter ChatItemId Int diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 0f33a9d7e3..5f75417898 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -538,20 +538,17 @@ processChatCommand' vr = \case Just (CIFFGroup _ _ (Just gId) (Just fwdItemId)) -> Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTGroup gId) fwdItemId) _ -> pure Nothing - APISendMessages (ChatRef cType chatId) live itemTTL cms -> withUser $ \user -> mapM_ assertAllowedContent' cms >> case cType of - CTDirect -> do + APISendMessages sendRef live itemTTL cms -> withUser $ \user -> mapM_ assertAllowedContent' cms >> case sendRef of + SRDirect chatId -> do mapM_ assertNoMentions cms withContactLock "sendMessage" chatId $ sendContactContentMessages user chatId live itemTTL (L.map composedMessageReq cms) - CTGroup -> + SRGroup chatId directMemberId -> withGroupLock "sendMessage" chatId $ do (gInfo, cmrs) <- withFastStore $ \db -> do g <- getGroupInfo db vr user chatId (g,) <$> mapM (composedMessageReqMentions db user g) cms - sendGroupContentMessages user gInfo live itemTTL cmrs - CTLocal -> pure $ chatCmdError (Just user) "not supported" - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + sendGroupContentMessages user gInfo directMemberId live itemTTL cmrs APICreateChatTag (ChatTagData emoji text) -> withUser $ \user -> withFastStore' $ \db -> do _ <- createChatTag db user emoji text CRChatTags user <$> getUserChatTags db user @@ -849,7 +846,7 @@ processChatCommand' vr = \case Just cmrs' -> withGroupLock "forwardChatItem, to group" toChatId $ do gInfo <- withFastStore $ \db -> getGroupInfo db vr user toChatId - sendGroupContentMessages user gInfo False itemTTL cmrs' + sendGroupContentMessages user gInfo Nothing False itemTTL cmrs' Nothing -> pure $ CRNewChatItems user [] CTLocal -> do cmrs <- prepareForward user @@ -1840,8 +1837,8 @@ processChatCommand' vr = \case CTDirect -> withFastStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case Right ctId -> do - let chatRef = ChatRef CTDirect ctId - processChatCommand $ APISendMessages chatRef False Nothing [composedMessage Nothing mc] + let sendRef = SRDirect ctId + processChatCommand $ APISendMessages sendRef False Nothing [composedMessage Nothing mc] Left _ -> withFastStore' (\db -> runExceptT $ getActiveMembersByName db vr user name) >>= \case Right [(gInfo, member)] -> do @@ -1856,8 +1853,8 @@ processChatCommand' vr = \case (gId, mentions) <- withFastStore $ \db -> do gId <- getGroupIdByName db user name (gId,) <$> liftIO (getMessageMentions db user gId msg) - let chatRef = ChatRef CTGroup gId - processChatCommand $ APISendMessages chatRef False Nothing [ComposedMessage Nothing Nothing mc mentions] + let sendRef = SRGroup gId Nothing + processChatCommand $ APISendMessages sendRef False Nothing [ComposedMessage Nothing Nothing mc mentions] CTLocal | name == "" -> do folderId <- withFastStore (`getUserNoteFolderId` user) @@ -1879,12 +1876,13 @@ processChatCommand' vr = \case processChatCommand $ APISendMemberContactInvitation contactId (Just mc) cr -> pure cr Just ctId -> do - let chatRef = ChatRef CTDirect ctId - processChatCommand $ APISendMessages chatRef False Nothing [composedMessage Nothing mc] + let sendRef = SRDirect ctId + processChatCommand $ APISendMessages sendRef False Nothing [composedMessage Nothing mc] SendLiveMessage chatName msg -> withUser $ \user -> do (chatRef, mentions) <- getChatRefAndMentions user chatName msg - let mc = MCText msg - processChatCommand $ APISendMessages chatRef True Nothing [ComposedMessage Nothing Nothing mc mentions] + withSendRef chatRef $ \sendRef -> do + let mc = MCText msg + processChatCommand $ APISendMessages sendRef True Nothing [ComposedMessage Nothing Nothing mc mentions] SendMessageBroadcast msg -> withUser $ \user -> do contacts <- withFastStore' $ \db -> getUserContacts db vr user withChatLock "sendMessageBroadcast" . procCmd $ do @@ -1929,7 +1927,7 @@ processChatCommand' vr = \case contactId <- withFastStore $ \db -> getContactIdByName db user cName quotedItemId <- withFastStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg let mc = MCText msg - processChatCommand $ APISendMessages (ChatRef CTDirect contactId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc M.empty] + processChatCommand $ APISendMessages (SRDirect contactId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc M.empty] DeleteMessage chatName deletedMsg -> withUser $ \user -> do chatRef <- getChatRef user chatName deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg @@ -2235,7 +2233,7 @@ processChatCommand' vr = \case qiId <- getGroupChatItemIdByText db user gId cName quotedMsg (gId, qiId,) <$> liftIO (getMessageMentions db user gId msg) let mc = MCText msg - processChatCommand $ APISendMessages (ChatRef CTGroup groupId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc mentions] + processChatCommand $ APISendMessages (SRGroup groupId Nothing) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc mentions] ClearNoteFolder -> withUser $ \user -> do folderId <- withFastStore (`getUserNoteFolderId` user) processChatCommand $ APIClearChat (ChatRef CTLocal folderId) @@ -2276,15 +2274,16 @@ processChatCommand' vr = \case chatRef <- getChatRef user chatName case chatRef of ChatRef CTLocal folderId -> processChatCommand $ APICreateChatItems folderId [composedMessage (Just f) (MCFile "")] - _ -> processChatCommand $ APISendMessages chatRef False Nothing [composedMessage (Just f) (MCFile "")] + _ -> withSendRef chatRef $ \sendRef -> processChatCommand $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCFile "")] SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do chatRef <- getChatRef user chatName - filePath <- lift $ toFSFilePath fPath - unless (any (`isSuffixOf` map toLower fPath) imageExtensions) $ throwChatError CEFileImageType {filePath} - fileSize <- getFileSize filePath - unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath} - -- TODO include file description for preview - processChatCommand $ APISendMessages chatRef False Nothing [composedMessage (Just f) (MCImage "" fixedImagePreview)] + withSendRef chatRef $ \sendRef -> do + filePath <- lift $ toFSFilePath fPath + unless (any (`isSuffixOf` map toLower fPath) imageExtensions) $ throwChatError CEFileImageType {filePath} + fileSize <- getFileSize filePath + unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath} + -- TODO include file description for preview + processChatCommand $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCImage "" fixedImagePreview)] ForwardFile chatName fileId -> forwardFile chatName fileId SendFile ForwardImage chatName fileId -> forwardFile chatName fileId SendImage SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO" @@ -3066,10 +3065,16 @@ processChatCommand' vr = \case quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True) quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False) quoteData _ = throwError SEInvalidQuote - sendGroupContentMessages :: User -> GroupInfo -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse - sendGroupContentMessages user gInfo live itemTTL cmrs = do + sendGroupContentMessages :: User -> GroupInfo -> Maybe GroupMemberId -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse + sendGroupContentMessages user gInfo@GroupInfo {membership} directMemberId live itemTTL cmrs = do assertMultiSendable live cmrs - ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo + ms <- case directMemberId of + Nothing -> withFastStore' $ \db -> getGroupMembers db vr user gInfo + Just dmId -> do + when (dmId == groupMemberId' membership) $ throwChatError $ CECommandError "cannot send to self" + dm <- withFastStore $ \db -> getGroupMemberById db vr user dmId + unless (memberStatus dm == GSMemPendingApproval) $ throwChatError $ CECommandError "cannot send directly to member not pending approval" + pure [dm] sendGroupContentMessages_ user gInfo ms live itemTTL cmrs sendGroupContentMessages_ :: User -> GroupInfo -> [GroupMember] -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} ms live itemTTL cmrs = do @@ -3266,6 +3271,11 @@ processChatCommand' vr = \case getConnQueueInfo user Connection {connId, agentConnId = AgentConnId acId} = do msgInfo <- withFastStore' (`getLastRcvMsgInfo` connId) CRQueueInfo user msgInfo <$> withAgent (`getConnectionQueueInfo` acId) + withSendRef :: ChatRef -> (SendRef -> CM ChatResponse) -> CM ChatResponse + withSendRef chatRef a = case chatRef of + ChatRef CTDirect cId -> a $ SRDirect cId + ChatRef CTGroup gId -> a $ SRGroup gId Nothing + _ -> throwChatError $ CECommandError "not supported" protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) protocolServers p (operators, smpServers, xftpServers) = case p of @@ -3748,7 +3758,7 @@ chatCommandP = "/_get chat " *> (APIGetChat <$> chatRefP <*> optional (" content=" *> strP) <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)), "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)), "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal), - "/_send " *> (APISendMessages <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)), + "/_send " *> (APISendMessages <$> sendRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)), "/_create tag " *> (APICreateChatTag <$> jsonP), "/_tags " *> (APISetChatTags <$> chatRefP <*> optional _strP), "/_delete tag " *> (APIDeleteChatTag <$> A.decimal), @@ -4121,6 +4131,9 @@ chatCommandP = ct -> ChatName ct <$> displayNameP chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayNameP chatRefP = ChatRef <$> chatTypeP <*> A.decimal + sendRefP = + (A.char '@' $> SRDirect <*> A.decimal) + <|> (A.char '#' $> SRGroup <*> A.decimal <*> optional (" @" *> A.decimal)) msgCountP = A.space *> A.decimal <|> pure 10 ciTTLDecimal = ("default" $> Nothing) <|> (Just <$> A.decimal) ciTTL = diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index b1e5bf59d7..26bf4edbc9 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -78,10 +78,7 @@ where import Control.Monad import Control.Monad.Except import Control.Monad.IO.Class -import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson.TH as J -import qualified Data.Attoparsec.ByteString.Char8 as A -import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty) @@ -104,15 +101,15 @@ import Simplex.Chat.Types.UITheme import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..)) import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId) import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow) -import Simplex.Messaging.Agent.Store.DB (BoolInt (..), FromField (..), ToField (..)) +import Simplex.Messaging.Agent.Store.DB (BoolInt (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON) +import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode) import Simplex.Messaging.Transport.Client (TransportHost) -import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) +import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8) #if defined(dbPostgres) import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..)) import Database.PostgreSQL.Simple.SqlQQ (sql) diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index f4cf2bccb8..38eb90649f 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -316,6 +316,7 @@ CREATE TABLE user_contact_links( group_link_id BLOB, group_link_member_role TEXT NULL, business_address INTEGER DEFAULT 0, + group_link_auto_accept TEXT NULL, UNIQUE(user_id, local_display_name) ); CREATE TABLE contact_requests( diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index fc2aa466aa..84d619d514 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1086,7 +1086,7 @@ instance TextEncoding GroupMemberStatus where "intro-inv" -> Just GSMemIntroInvited "accepted" -> Just GSMemAccepted "announced" -> Just GSMemAnnounced - "pending" -> Just GSMemPendingApproval + "pending_approval" -> Just GSMemPendingApproval "connected" -> Just GSMemConnected "complete" -> Just GSMemComplete "creator" -> Just GSMemCreator @@ -1102,7 +1102,7 @@ instance TextEncoding GroupMemberStatus where GSMemIntroInvited -> "intro-inv" GSMemAccepted -> "accepted" GSMemAnnounced -> "announced" - GSMemPendingApproval -> "pending" + GSMemPendingApproval -> "pending_approval" GSMemConnected -> "connected" GSMemComplete -> "complete" GSMemCreator -> "creator" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 6625fb8094..1ca2184095 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -184,6 +184,8 @@ chatGroupTests = do it "should send updated mentions in history" testGroupHistoryWithMentions describe "uniqueMsgMentions" testUniqueMsgMentions describe "updatedMentionNames" testUpdatedMentionNames + describe "group direct messages" $ do + it "should send group direct messages" testGroupDirectMessages testGroupCheckMessages :: HasCallStack => TestParams -> IO () testGroupCheckMessages = @@ -6392,3 +6394,28 @@ testUpdatedMentionNames = do mentionedMember name_ = CIMention {memberId = MemberId "abcd", memberRef = ciMentionMember <$> name_} where ciMentionMember name = CIMentionMember {groupMemberId = 1, displayName = name, localAlias = Nothing, memberRole = GRMember} + +testGroupDirectMessages :: HasCallStack => TestParams -> IO () +testGroupDirectMessages = + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do + createGroup3 "team" alice bob cath + + alice #> "#team 1" + [bob, cath] *<# "#team alice> 1" + + bob #> "#team 2" + [alice, cath] *<# "#team bob> 2" + + void $ withCCTransaction alice $ \db -> + DB.execute_ db "UPDATE group_members SET member_status='pending_approval' WHERE group_member_id = 2" + + alice ##> "/_send #1 @2 text 3" + alice <# "#team 3" + bob <# "#team alice> 3" + + void $ withCCTransaction bob $ \db -> + DB.execute_ db "UPDATE group_members SET member_status='pending_approval' WHERE group_member_id = 1" + + bob ##> "/_send #1 @1 text 4" + bob <# "#team 4" + alice <# "#team bob> 4"