Merge branch 'stable'

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 {

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

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

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

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)
 

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 </)
     (cath </)
     bob `send` ("@alice \"" <> inv <> "\\ntest\"")

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