diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 764abf8a68..ca4f3e8fcf 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -3718,7 +3718,7 @@ processChatCommand cxt nm = \case profileToSend <- presentUserBadge user incognitoProfile $ case gInfo_ of Just gInfo_' -> - let allowSimplexLinks = maybe True (groupFeatureUserAllowed SGFSimplexLinks) gInfo_' + let allowSimplexLinks = maybe True groupUserAllowSimplexLinks gInfo_' in userProfileInGroup' user allowSimplexLinks incognitoProfile Nothing -> userProfileDirect user incognitoProfile Nothing True chatEvent <- case gInfo_ of @@ -4031,7 +4031,7 @@ processChatCommand cxt nm = \case conn <- createRelayConnection db cxt user (groupMemberId' relayMember) connId ConnPrepared chatV subMode pure (relayMember, conn, groupRelay) let GroupMember {memberRole = userRole, memberId = userMemberId} = membership - allowSimplexLinks = groupFeatureUserAllowed SGFSimplexLinks gInfo + allowSimplexLinks = groupUserAllowSimplexLinks gInfo GroupMember {memberId = relayMemberId} = relayMember membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership let relayInv = GroupRelayInvitation { diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 5439385437..45688ae6e9 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -367,7 +367,7 @@ prohibitedGroupContent gInfo@GroupInfo {membership = mem@GroupMember {memberRole prohibitedSimplexLinks :: GroupInfo -> GroupMember -> MsgContent -> Maybe MarkdownList -> Bool prohibitedSimplexLinks gInfo m mc ft = not (groupFeatureMemberAllowed SGFSimplexLinks m gInfo) - && (isChatLink mc || maybe False (any ftIsSimplexLink) ft) + && (isChatLink mc || maybe False (any ftIsSimplexLink) ft || hasObfuscatedSimplexLink (msgContentText mc)) where isChatLink = \case MCChat {} -> True @@ -1186,7 +1186,7 @@ introduceInChannel cxt user gInfo subscriber@GroupMember {activeConn = Just conn setMembersVectorsNewRelation db modMs subscriberIdx IDSubjectIntroduced MRIntroduced userProfileInGroup :: User -> GroupInfo -> Maybe Profile -> Profile -userProfileInGroup user = userProfileInGroup' user . groupFeatureUserAllowed SGFSimplexLinks +userProfileInGroup user = userProfileInGroup' user . groupUserAllowSimplexLinks {-# INLINE userProfileInGroup #-} userProfileInGroup' :: User -> Bool -> Maybe Profile -> Profile @@ -1204,7 +1204,7 @@ memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, a memberKey = MemberKey <$> memberPubKey } where - allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m g + allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m g && groupFeatureMemberAllowed SGFDirectMessages m g redactedMemberProfile :: Bool -> Profile -> Profile redactedMemberProfile allowSimplexLinks Profile {displayName, fullName, shortDescr, image, peerType, badge} = @@ -1212,6 +1212,7 @@ redactedMemberProfile allowSimplexLinks Profile {displayName, fullName, shortDes where removeSimplexLink s | allowSimplexLinks = Just s + | hasObfuscatedSimplexLink s = Nothing | otherwise = maybe (Just s) (\fts -> if any ftIsSimplexLink fts then Nothing else Just s) $ parseMaybeMarkdownList s sendHistory :: User -> GroupInfo -> GroupMember -> CM () @@ -2172,7 +2173,7 @@ sendGroupMessages user gInfo scope asGroup members events = do _ -> False sendProfileUpdate = do let members' = filter (`supportsVersion` memberProfileUpdateVersion) members - allowSimplexLinks = groupFeatureUserAllowed SGFSimplexLinks gInfo + allowSimplexLinks = groupUserAllowSimplexLinks gInfo -- shouldSendProfileUpdate excludes incognito membership, so the badge is presented profileUpdate <- presentUserBadge user Nothing $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile p void $ sendGroupMessage' user gInfo members' $ XInfo profileUpdate diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 95500162c8..7516d33b70 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -823,7 +823,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = XGrpMemInfo memId _memProfile | sameMemberId memId m -> do let GroupMember {memberId = membershipMemId} = membership - allowSimplexLinks = groupFeatureUserAllowed SGFSimplexLinks gInfo + allowSimplexLinks = groupUserAllowSimplexLinks gInfo membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability @@ -2730,7 +2730,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = pure m where contentChanged = not (sameProfileContent (redactedMemberProfile allowSimplexLinks (fromLocalProfile p)) (redactedMemberProfile allowSimplexLinks p')) - allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m gInfo + allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m gInfo && groupFeatureMemberAllowed SGFDirectMessages m gInfo updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of Just bc | isMainBusinessMember bc m -> do g' <- withStore $ \db -> updateGroupProfileFromMember db user g p' @@ -3121,7 +3121,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = pure toMember subMode <- chatReadVar subscriptionMode -- [incognito] send membership incognito profile, create direct connection as incognito - let allowSimplexLinks = groupFeatureUserAllowed SGFSimplexLinks gInfo + let allowSimplexLinks = groupUserAllowSimplexLinks gInfo membershipProfile <- presentUserBadge user (incognitoMembershipProfile gInfo) $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile -- [async agent commands] no continuation needed, but commands should be asynchronous for stability diff --git a/src/Simplex/Chat/Markdown.hs b/src/Simplex/Chat/Markdown.hs index 9507375527..e8cd381941 100644 --- a/src/Simplex/Chat/Markdown.hs +++ b/src/Simplex/Chat/Markdown.hs @@ -18,6 +18,7 @@ import Control.Monad import Data.Aeson (FromJSON, ToJSON) import qualified Data.Aeson as J import qualified Data.Aeson.TH as JQ +import qualified Data.Attoparsec.ByteString.Char8 as AB import Data.Attoparsec.Text (Parser) import qualified Data.Attoparsec.Text as A import Data.ByteString.Char8 (ByteString) @@ -191,6 +192,16 @@ isLink = \case hasLinks :: MarkdownList -> Bool hasLinks = any $ \(FormattedText f _) -> maybe False isLink f +hasObfuscatedSimplexLink :: Text -> Bool +hasObfuscatedSimplexLink t = + fromRight False $ AB.parseOnly findLinkP $ encodeUtf8 $ T.filter (not . isSpace) t + where + findLinkP = do + AB.skipWhile (\c -> c /= 's' && c /= 'h') -- links start only with "simplex:" or "https://" + (True <$ (strP :: AB.Parser AConnectionLink)) + <|> (AB.anyChar *> findLinkP) + <|> pure False + markdownP :: Parser Markdown markdownP = mconcat <$> A.many' fragmentP where diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index f9e36a86ad..f23ea8a041 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -640,6 +640,12 @@ groupFeatureUserAllowed :: GroupFeatureRoleI f => SGroupFeature f -> GroupInfo - groupFeatureUserAllowed feature GroupInfo {membership = GroupMember {memberRole}, fullGroupPreferences} = groupFeatureMemberAllowed' feature memberRole fullGroupPreferences +-- A connection link in a profile description enables a direct connection, so a description +-- keeps its links only when both SimpleX links and direct messages are allowed. +groupUserAllowSimplexLinks :: GroupInfo -> Bool +groupUserAllowSimplexLinks g = + groupFeatureUserAllowed SGFSimplexLinks g && groupFeatureUserAllowed SGFDirectMessages g + mergeUserChatPrefs :: User -> Contact -> FullPreferences mergeUserChatPrefs user ct = mergeUserChatPrefs' user (contactConnIncognito ct) (userPreferences ct) diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index efcb582502..fb56d39aae 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -2906,6 +2906,12 @@ testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfil bob <## "bad chat command: feature not allowed SimpleX links" bob ##> ("/_send #1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"" <> inv <> "\\ntest\"}}]") bob <## "bad chat command: feature not allowed SimpleX links" + -- a link split with a space or a newline is still blocked + let (lnk1, lnk2) = splitAt 12 inv + bob ##> ("#team \"" <> lnk1 <> " " <> lnk2 <> "\"") + bob <## "bad chat command: feature not allowed SimpleX links" + bob ##> ("#team \"" <> lnk1 <> "\\n" <> lnk2 <> "\"") + bob <## "bad chat command: feature not allowed SimpleX links" (alice inv <> "\\ntest\"") diff --git a/tests/MarkdownTests.hs b/tests/MarkdownTests.hs index efa010ceb1..2a5328ff26 100644 --- a/tests/MarkdownTests.hs +++ b/tests/MarkdownTests.hs @@ -25,6 +25,7 @@ markdownTests = do textColor textWithUri textWithHyperlink + obfuscatedSimplexLinks textWithEmail textWithPhone textWithMentions @@ -284,6 +285,24 @@ textWithHyperlink = describe "text with HyperLink without link text" do "[click here](example.com)" <==> "[click here](example.com)" "[click here](https://example.com )" <==> "[click here](https://example.com )" +obfuscatedSimplexLinks :: Spec +obfuscatedSimplexLinks = describe "SimpleX links obfuscated with whitespace" do + let addr = "https://smp6.simplex.im/a#lrdvu2d8A1GumSmoKb2krQmtKhWXq-tyGpHuM7aMwsw" + inv = "/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + let spaced s = T.replace "://" ":// " s -- insert a space right after the scheme + it "detects links split with spaces or newlines" do + hasObfuscatedSimplexLink addr `shouldBe` True + hasObfuscatedSimplexLink (spaced addr) `shouldBe` True + hasObfuscatedSimplexLink (T.intercalate "\n" $ T.chunksOf 8 addr) `shouldBe` True + hasObfuscatedSimplexLink ("connect with me: " <> spaced addr) `shouldBe` True + hasObfuscatedSimplexLink (T.intercalate " " $ T.chunksOf 8 $ "https://simplex.chat" <> inv) `shouldBe` True + it "detects a split link followed by other text" do + hasObfuscatedSimplexLink (spaced addr <> "\nplease connect") `shouldBe` True + it "ignores text without a SimpleX link" do + hasObfuscatedSimplexLink "" `shouldBe` False + hasObfuscatedSimplexLink "hello there, this is a normal message" `shouldBe` False + hasObfuscatedSimplexLink "see https://example.com/page?ref=123 for details" `shouldBe` False + email :: Text -> Markdown email = Markdown $ Just Email