From fee2bcc6529ad9e3d2470c8240339461465f4b73 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Mon, 13 Apr 2026 19:23:09 +0000 Subject: [PATCH] more implementation, tests --- src/Simplex/Chat/Controller.hs | 1 + src/Simplex/Chat/Library/Commands.hs | 16 +++-- src/Simplex/Chat/Library/Subscriber.hs | 62 +++++++++++++++---- src/Simplex/Chat/Store/Groups.hs | 39 +++++++++--- .../Migrations/M20260413_chat_hidden.hs | 2 + src/Simplex/Chat/Types.hs | 9 +-- tests/ChatTests/ChatRelays.hs | 2 + 7 files changed, 99 insertions(+), 32 deletions(-) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index a06945c779..98b7d95b3d 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -377,6 +377,7 @@ data ChatCommand | APIGetConnNtfMessages (NonEmpty ConnMsgReq) | APIAddMember {groupId :: GroupId, contactId :: ContactId, memberRole :: GroupMemberRole} | APISharePublicGroup {groupId :: GroupId, toChatRef :: ChatRef} + | APIRevealPublicGroup {groupId :: GroupId} | APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter} | APIAcceptMember {groupId :: GroupId, groupMemberId :: GroupMemberId, memberRole :: GroupMemberRole} | APIDeleteMemberSupportChat GroupId GroupMemberId diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 4101493079..5b8b4e67f1 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1947,7 +1947,7 @@ processChatCommand vr nm = \case groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences groupProfile = businessGroupProfile profile groupPreferences gVar <- asks random - (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user groupProfile True (toPreparedConnLink ccLink) welcomeSharedMsgId False GRMember Nothing + (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user groupProfile True (toPreparedConnLink ccLink) welcomeSharedMsgId False GRMember Nothing False hostMember <- maybe (throwCmdError "no host member") pure hostMember_ void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) let cd = CDGroupRcv gInfo Nothing hostMember @@ -1979,7 +1979,7 @@ processChatCommand vr nm = \case let useRelays = not direct subRole <- if useRelays then asks $ channelSubscriberRole . config else pure GRMember gVar <- asks random - (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user gp False (toPreparedConnLink ccLink) welcomeSharedMsgId useRelays subRole publicMemberCount_ + (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user gp False (toPreparedConnLink ccLink) welcomeSharedMsgId useRelays subRole publicMemberCount_ False void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) let cd = maybe (CDChannelRcv gInfo Nothing) (CDGroupRcv gInfo Nothing) hostMember_ cInfo = GroupChat gInfo Nothing @@ -2060,8 +2060,8 @@ processChatCommand vr nm = \case gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId case gInfo of GroupInfo {preparedGroup = Nothing} -> throwCmdError "group doesn't have link to connect" - GroupInfo {useRelays = BoolDef True, preparedGroup = Just PreparedGroup {connLinkToConnect = PreparedConnLink {connShortLink = sLnk_}}} -> do - sLnk <- case sLnk_ of + GroupInfo {useRelays = BoolDef True, preparedGroup = Just PreparedGroup {connLinkToConnect}} -> do + sLnk <- case connShortLink' connLinkToConnect of Just sl -> pure sl Nothing -> throwChatError $ CEException "failed to retrieve relays: no short link" (FixedLinkData {linkConnReq = mainCReq@(CRContactUri crData), linkEntityId, rootKey}, cData@(ContactLinkData _ UserContactData {owners, relays})) <- getShortLinkConnReq nm user sLnk @@ -2484,7 +2484,8 @@ processChatCommand vr nm = \case pure $ CRSentPublicGroupInvitation user gInfo case toChatRef of ChatRef CTDirect contactId _ -> do - ct@Contact {activeConn = Just ctConn} <- withFastStore $ \db -> getContact db vr user contactId + ct <- withFastStore $ \db -> getContact db vr user contactId + ctConn <- liftEither $ contactSendConn_ ct groupOwner <- forM (groupKeys gInfo) $ \GroupKeys {memberPrivKey} -> do adHash <- withAgent $ \a -> getConnectionRatchetAdHash a (aConnId ctConn) let invBody = encodeUtf8 $ encodeJSON groupProfile @@ -2502,6 +2503,10 @@ processChatCommand vr nm = \case msg <- sendGroupMessage user toGInfo scope members $ XGrpInvPub inv sendInv Nothing msg (CDGroupSnd toGInfo Nothing) (GroupChat toGInfo Nothing) _ -> throwCmdError "unsupported chat type" + APIRevealPublicGroup groupId -> withUser $ \user -> do + withStore' $ \db -> setGroupChatHidden db user groupId False + gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId + pure $ CRSentPublicGroupInvitation user gInfo -- reusing response, just returns group info APIAddMember groupId contactId memRole -> withUser $ \user -> withGroupLock "addMember" groupId $ do -- TODO for large groups: no need to load all members to determine if contact is a member (group, contact) <- withFastStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db vr user contactId @@ -4849,6 +4854,7 @@ chatCommandP = "/_ntf conn messages " *> (APIGetConnNtfMessages <$> connMsgsP), "/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole), "/_share #" *> (APISharePublicGroup <$> A.decimal <* A.space <*> chatRefP), + "/_reveal #" *> (APIRevealPublicGroup <$> A.decimal), "/share " *> char_ '#' *> (SharePublicGroup <$> displayNameP <* A.space <*> chatNameP), "/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI "/_accept member #" *> (APIAcceptMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole), diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index a612efb0fc..7593452bcd 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -33,10 +33,10 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe) +import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, isNothing, mapMaybe) import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeLatin1) +import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) import qualified Data.UUID as UUID import qualified Data.UUID.V4 as V4 @@ -679,7 +679,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = LDATA fixedLinkData cData -> withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> case cmdFunction of - CFGetGroupDataInv -> processPublicGroupLinkData user ct conn fixedLinkData cData + CFGetGroupDataInv gId -> verifyPublicGroupOwnerSig gId conn fixedLinkData cData _ -> throwChatError $ CECommandError "unexpected cmdFunction" QCONT -> void $ continueSending connEntity conn @@ -1175,6 +1175,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = else -- TODO [relays] owner: TBC failed RelayStatus? messageError "relay link: relay member ID mismatch" + CFGetGroupDataInv gId -> verifyPublicGroupOwnerSig gId conn (FixedLinkData {agentVRange = supportedSMPAgentVRange, rootKey = relayKey, linkConnReq = cReq, linkEntityId}) cData _ -> throwChatError $ CECommandError "unexpected cmdFunction" QCONT -> do continued <- continueSending connEntity conn @@ -2428,29 +2429,64 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = rcvPublicGroupInvitation :: forall c. (ChatTypeI c, ChatTypeQuotable c) => Connection -> PublicGroupInvitation -> RcvMessage -> UTCTime -> ChatDirection c 'MDRcv -> ChatInfo c -> CM (GroupInfo, ChatItem c 'MDRcv) rcvPublicGroupInvitation conn PublicGroupInvitation {groupProfile, groupOwner, groupSize} msg brokerTs cd cInfo = do unless (isJust $ publicGroup groupProfile) $ messageError "x.grp.inv.pub: not a public group" + let PublicGroupProfile {publicGroupId} = fromJust $ publicGroup groupProfile let oss = case groupOwner of Nothing -> Nothing Just _ -> Just OSSPending sLnk_ = (\PublicGroupProfile {groupLink = gl} -> gl) <$> publicGroup groupProfile prepLink = PreparedConnLink {connFullLink = Nothing, connShortLink = sLnk_} - gVar <- asks random - subRole <- asks $ channelSubscriberRole . config - (gInfo@GroupInfo {groupId, localDisplayName, membership = GroupMember {groupMemberId}}, _) <- withStore $ \db -> - createPreparedGroup db gVar vr user groupProfile False prepLink Nothing True subRole (Just $ fromIntegral groupSize) - withStore' $ \db -> setGroupChatHidden db user groupId True + -- reuse existing hidden group for same publicGroupId + existingGId <- withStore' $ \db -> getHiddenGroupByPublicGroupId db userId publicGroupId + (gInfo@GroupInfo {groupId, localDisplayName, membership = GroupMember {groupMemberId}}, _) <- case existingGId of + Just gId -> do + g <- withFastStore $ \db -> getGroupInfo db vr user gId + pure (g, Nothing) + Nothing -> do + gVar <- asks random + subRole <- asks $ channelSubscriberRole . config + withStore $ \db -> createPreparedGroup db gVar vr user groupProfile False prepLink Nothing True subRole (Just $ fromIntegral groupSize) True + forM_ groupOwner $ \sig -> withStore' $ \db -> setGroupOwnerSig db groupId sig let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending, ownerSigStatus = oss}) GRObserver (ci, _) <- saveRcvChatItemNoParse user cd msg brokerTs content withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) toView $ CEvtNewChatItems user [AChatItem chatTypeI SMDRcv cInfo ci] forM_ groupOwner $ \_ -> forM_ sLnk_ $ \sLnk -> - void $ getAgentConnShortLinkAsync user CFGetGroupDataInv (Just conn) sLnk + void $ getAgentConnShortLinkAsync user (CFGetGroupDataInv groupId) (Just conn) sLnk pure (gInfo, ci) - processPublicGroupLinkData :: User -> Contact -> Connection -> FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> CM () - processPublicGroupLinkData _user _ct _conn _fixedLinkData _cData = do - -- TODO: verify owner signature, update chat item ownerSigStatus - pure () + verifyPublicGroupOwnerSig :: GroupId -> Connection -> FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> CM () + verifyPublicGroupOwnerSig gId conn FixedLinkData {linkConnReq, linkEntityId} (ContactLinkData _ UserContactData {owners}) = do + ownerSig_ <- withStore' $ \db -> getGroupOwnerSig db gId + forM_ ownerSig_ $ \GroupOwnerSig {memberId = mId, binding = B64UrlByteString bd, ownerSig = B64UrlByteString sigBytes} -> do + gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId + let GroupInfo {groupProfile = gp} = gInfo + adHash <- withAgent $ \a -> getConnectionRatchetAdHash a (aConnId conn) + let oss = either (OSSFailed . T.pack) (const OSSVerified) $ do + PublicGroupProfile {publicGroupId = B64UrlByteString pgId} <- maybe (Left "no public group profile") Right (publicGroup gp) + unless (linkEntityId == Just pgId) $ Left "group identity mismatch" + unless (bd == adHash) $ Left "binding data mismatch" + OwnerAuth {ownerKey} <- maybe (Left "unknown member ID") Right $ + find (\OwnerAuth {ownerId} -> ownerId == unMemberId mId) owners + sig <- C.decodeSignature sigBytes + let invBody = encodeUtf8 $ encodeJSON gp + signedContent = smpEncode CBDirect <> bd <> invBody + unless (C.verify' ownerKey sig signedContent) $ Left "signature verification failed" + -- update conn_full_link_to_connect from resolved link + currentTs <- liftIO getCurrentTime + withStore' $ \db -> + DB.execute db "UPDATE groups SET conn_full_link_to_connect = ?, updated_at = ? WHERE group_id = ?" (linkConnReq, currentTs, gId) + -- update chat item ownerSigStatus + updatePublicGroupInvitationStatus gId oss `catchAllErrors` eToView + + updatePublicGroupInvitationStatus :: GroupId -> OwnerSigStatus -> CM () + updatePublicGroupInvitationStatus gId oss = do + AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db vr user gId + case (cInfo, content) of + (DirectChat ct, CIRcvGroupInvitation ciGroupInv memRole) -> do + let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation (ciGroupInv {ownerSigStatus = Just oss} :: CIGroupInvitation) memRole + updateDirectChatItemView user ct itemId aciContent False False Nothing Nothing + _ -> pure () checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> CM () checkIntegrityCreateItem cd MsgMeta {integrity, broker = (_, brokerTs)} = case integrity of diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index cce63637fe..bf4c4b7a0b 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -41,6 +41,9 @@ module Simplex.Chat.Store.Groups createGroupRejectedViaLink, setGroupInvitationChatItemId, setGroupChatHidden, + setGroupOwnerSig, + getGroupOwnerSig, + getHiddenGroupByPublicGroupId, getGroup, getGroupInfoByUserContactLinkConnReq, getGroupInfoViaUserShortLink, @@ -185,6 +188,8 @@ import Data.Either (rights) import Data.Functor (($>)) import Data.Int (Int64) import Data.List (partition, sortOn) +import qualified Data.Aeson as J +import qualified Data.ByteString.Lazy as LB import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) import Data.Ord (Down (..)) import Data.Text (Text) @@ -602,11 +607,11 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile { DB.execute db "DELETE FROM contacts WHERE contact_id = ?" (Only contactId) DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId) -createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> User -> GroupProfile -> Bool -> PreparedGroupLink -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember) -createPreparedGroup db gVar vr user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ = do +createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> User -> GroupProfile -> Bool -> PreparedGroupLink -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> Bool -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember) +createPreparedGroup db gVar vr user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ chatHidden = do currentTs <- liftIO getCurrentTime let prepared = Just (connLinkToConnect, welcomeSharedMsgId) - (groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs + (groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ chatHidden currentTs hostMemberId_ <- if useRelays then pure Nothing @@ -815,7 +820,7 @@ createGroupViaLink' business membershipStatus = do currentTs <- liftIO getCurrentTime - (groupId, _groupLDN) <- createGroup_ db userId groupProfile Nothing business False Nothing Nothing currentTs + (groupId, _groupLDN) <- createGroup_ db userId groupProfile Nothing business False Nothing Nothing False currentTs hostMemberId <- insertHost_ currentTs groupId liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId) -- using IBUnknown since host is created without contact @@ -842,8 +847,8 @@ createGroupViaLink' ) insertedRowId db -createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (PreparedGroupLink, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> Bool -> Maybe RelayStatus -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (GroupId, Text) -createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus publicMemberCount_ currentTs = ExceptT $ do +createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (PreparedGroupLink, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> Bool -> Maybe RelayStatus -> Maybe Int64 -> Bool -> UTCTime -> ExceptT StoreError IO (GroupId, Text) +createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus publicMemberCount_ chatHidden currentTs = ExceptT $ do let GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission} = groupProfile (groupType_, groupLink_, publicGroupId_) = case publicGroup of Just PublicGroupProfile {groupType, groupLink, publicGroupId} -> (Just groupType, Just groupLink, Just publicGroupId) @@ -868,10 +873,10 @@ createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus p INSERT INTO groups (group_profile_id, local_display_name, user_id, enable_ntfs, created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id, - business_chat, business_member_id, customer_member_id, use_relays, relay_own_status, public_member_count) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + business_chat, business_member_id, customer_member_id, use_relays, relay_own_status, public_member_count, chat_hidden) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] - ((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. toPreparedGroupRow prepared :. businessChatInfoRow business :. (BI useRelays, relayOwnStatus, publicMemberCount_)) + ((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. toPreparedGroupRow prepared :. businessChatInfoRow business :. (BI useRelays, relayOwnStatus, publicMemberCount_, BI chatHidden)) groupId <- insertedRowId db pure (groupId, localDisplayName) @@ -885,6 +890,20 @@ setGroupChatHidden db User {userId} groupId hidden = do currentTs <- getCurrentTime DB.execute db "UPDATE groups SET chat_hidden = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (BI hidden, currentTs, userId, groupId) +setGroupOwnerSig :: DB.Connection -> GroupId -> GroupOwnerSig -> IO () +setGroupOwnerSig db groupId sig = + DB.execute db "UPDATE groups SET owner_sig = ? WHERE group_id = ?" (Binary (LB.toStrict $ J.encode sig), groupId) + +getGroupOwnerSig :: DB.Connection -> GroupId -> IO (Maybe GroupOwnerSig) +getGroupOwnerSig db groupId = + fmap (>>= (\(Binary bs) -> J.decodeStrict bs)) . maybeFirstRow fromOnly $ + DB.query db "SELECT owner_sig FROM groups WHERE group_id = ?" (Only groupId) + +getHiddenGroupByPublicGroupId :: DB.Connection -> UserId -> B64UrlByteString -> IO (Maybe GroupId) +getHiddenGroupByPublicGroupId db userId pgId = + maybeFirstRow fromOnly $ + DB.query db "SELECT g.group_id FROM groups g JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id WHERE g.user_id = ? AND g.chat_hidden = 1 AND gp.public_group_id = ?" (userId, pgId) + -- TODO return the last connection that is ready, not any last connection -- requires updating connection status getGroup :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO Group @@ -1528,7 +1547,7 @@ createRelayRequestGroup db vr user@User {userId} GroupRelayInvitation {fromMembe groupPreferences = Nothing, memberAdmission = Nothing } - (groupId, _groupLDN) <- createGroup_ db userId placeholderProfile Nothing Nothing True (Just RSInvited) Nothing currentTs + (groupId, _groupLDN) <- createGroup_ db userId placeholderProfile Nothing Nothing True (Just RSInvited) Nothing False currentTs -- Store relay request data for recovery liftIO $ setRelayRequestData_ groupId ownerMemberId <- insertOwner_ currentTs groupId diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260413_chat_hidden.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260413_chat_hidden.hs index a4fd7efae2..cd767d5012 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/M20260413_chat_hidden.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260413_chat_hidden.hs @@ -9,10 +9,12 @@ m20260413_chat_hidden :: Query m20260413_chat_hidden = [sql| ALTER TABLE groups ADD COLUMN chat_hidden INTEGER NOT NULL DEFAULT 0; +ALTER TABLE groups ADD COLUMN owner_sig BLOB; |] down_m20260413_chat_hidden :: Query down_m20260413_chat_hidden = [sql| ALTER TABLE groups DROP COLUMN chat_hidden; +ALTER TABLE groups DROP COLUMN owner_sig; |] diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 7a74919334..a40147ac9f 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -30,6 +30,7 @@ module Simplex.Chat.Types where import Control.Applicative ((<|>)) import Crypto.Number.Serialize (os2ip) import Data.Aeson (FromJSON (..), ToJSON (..)) +import Text.Read (readMaybe) import qualified Data.Aeson as J import qualified Data.Aeson.Encoding as JE import qualified Data.Aeson.TH as JQ @@ -1931,7 +1932,7 @@ data CommandFunction | CFSetShortLink | CFGetRelayDataJoin | CFGetRelayDataAccept - | CFGetGroupDataInv + | CFGetGroupDataInv GroupId deriving (Eq, Show) instance FromField CommandFunction where fromField = fromTextField_ textDecode @@ -1952,7 +1953,7 @@ instance TextEncoding CommandFunction where "set_short_link" -> Just CFSetShortLink "get_relay_data_join" -> Just CFGetRelayDataJoin "get_relay_data_accept" -> Just CFGetRelayDataAccept - "get_group_data_inv" -> Just CFGetGroupDataInv + s | Just gId <- T.stripPrefix "get_group_data_inv:" s -> CFGetGroupDataInv <$> readMaybe (T.unpack gId) _ -> Nothing textEncode = \case CFCreateConnGrpMemInv -> "create_conn" @@ -1967,7 +1968,7 @@ instance TextEncoding CommandFunction where CFSetShortLink -> "set_short_link" CFGetRelayDataJoin -> "get_relay_data_join" CFGetRelayDataAccept -> "get_relay_data_accept" - CFGetGroupDataInv -> "get_group_data_inv" + CFGetGroupDataInv gId -> "get_group_data_inv:" <> T.pack (show gId) commandExpectedResponse :: CommandFunction -> AEvtTag commandExpectedResponse = \case @@ -1983,7 +1984,7 @@ commandExpectedResponse = \case CFSetShortLink -> t LINK_ CFGetRelayDataJoin -> t LDATA_ CFGetRelayDataAccept -> t LDATA_ - CFGetGroupDataInv -> t LDATA_ + CFGetGroupDataInv _ -> t LDATA_ where t = AEvtTag SAEConn diff --git a/tests/ChatTests/ChatRelays.hs b/tests/ChatTests/ChatRelays.hs index 0c10a9c3ea..98f40c9d0f 100644 --- a/tests/ChatTests/ChatRelays.hs +++ b/tests/ChatTests/ChatRelays.hs @@ -182,6 +182,8 @@ testSharePublicGroupDirect ps = alice ##> "/share #team @cath" alice <## "shared public group #team" cath <## "alice (Alice) shared public group #team" + -- wait for async verification + threadDelay 1000000 testSharePublicGroupInGroup :: HasCallStack => TestParams -> IO () testSharePublicGroupInGroup ps =