allow SimpleX links with link text

This commit is contained in:
Evgeny Poberezkin 2025-05-11 23:13:26 +01:00
parent f0e46fa6f6
commit 460ab24415
No known key found for this signature in database
GPG key ID: 494BDDD9A28B577D
2 changed files with 23 additions and 7 deletions

View file

@ -31,7 +31,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnReqUriData (..), ConnShortLink (..), ConnectionLink (..), ConnectionRequestUri (..), ContactConnType (..), SMPQueue (..), simplexConnReqUri, simplexShortLink)
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnReqUriData (..), ConnShortLink (..), ConnectionLink (..), ConnectionRequestUri (..), ContactConnType (..), SMPQueue (..), qAddress, sameQAddress, simplexChat, simplexConnReqUri, simplexShortLink)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, sumTypeJSON)
import Simplex.Messaging.Protocol (ProtocolServer (..), sameSrvAddr)
@ -233,9 +233,6 @@ markdownP = mconcat <$> A.many' fragmentP
t <- A.char '[' *> A.takeWhile1 (/= ']') <* A.char ']'
uri <- A.char '(' *> A.takeWhile1 (/= ')') <* A.char ')'
sowLink <- either fail pure $ parseLinkUri uri
case sowLink of
SOWSimplex _ -> fail "SimpleX links with link text not supported"
SOWWeb _ -> pure ()
let t' = T.dropAround isPunctuation $ T.filter (not . isSpace) t
(linkUri, spoofed) = case either (\_ -> parseLinkUri ("https://" <> t')) Right $ parseLinkUri t' of
Right _
@ -345,7 +342,25 @@ markdownText (FormattedText f_ t) = case f_ of
Just uri | uri /= t && uri /= ("https://" <> t) ->
"[" <> t <> "](" <> uri <> ")"
_ -> t
SimplexLink {simplexUri} -> t
SimplexLink {simplexUri}
| sameUri -> t
| otherwise -> "[" <> t <> "](" <> safeDecodeUtf8 (strEncode simplexUri) <> ")"
where
sameUri = case (strDecode $ encodeUtf8 t, simplexUri) of
(Left _, _) -> False
(Right (ACL _ cLink), ACL _ cLink') -> case (cLink, cLink') of
(CLFull (CRContactUri cData), CLFull (CRContactUri cData')) ->
sameQueues (crSmpQueues cData) (crSmpQueues cData')
(CLFull (CRInvitationUri cData e2e), CLFull (CRInvitationUri cData' e2e')) ->
sameQueues (crSmpQueues cData) (crSmpQueues cData') && e2e == e2e'
(CLShort (CSLContact _ ct srv lKey), CLShort (CSLContact _ ct' srv' lKey')) ->
sameSrvAddr srv srv' && ct == ct' && lKey == lKey'
(CLShort (CSLInvitation _ srv lId lKey), CLShort (CSLInvitation _ srv' lId' lKey')) ->
sameSrvAddr srv srv' && lId == lId' && lKey == lKey'
_ -> False
sameQueues qs qs' = L.length qs == L.length qs' && all same (L.zip qs qs')
where
same (q, q') = sameQAddress (qAddress q) (qAddress q')
Mention _ -> t
Email -> t
Phone -> t

View file

@ -245,6 +245,9 @@ textWithHyperlink = describe "text with WebLink without link text" do
it "correct markdown" do
"[click here](https://example.com)" <==> weblink "https://example.com" "click here"
"For details [click here](https://example.com)" <==> "For details " <> weblink "https://example.com" "click here"
let 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"
("[Connect to me](https://simplex.chat" <> inv <> ")") ==> simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] "Connect to me"
("[Connect to me](simplex:" <> inv <> ")") <==> simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] "Connect to me"
it "spoofed link" do
"[https://example.com](https://another.com)" <==> spoofedLink "https://another.com" "https://example.com"
"[example.com/page](https://another.com/page)" <==> spoofedLink "https://another.com/page" "example.com/page"
@ -253,8 +256,6 @@ textWithHyperlink = describe "text with WebLink without link text" do
it "ignored as markdown" do
"[click here](example.com)" <==> "[click here](example.com)"
"[click here](https://example.com )" <==> "[click here](https://example.com )"
let 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"
("[Connect to me](https://simplex.chat" <> inv <> ")") <==> ("[Connect to me](https://simplex.chat" <> unmarked inv <> ")")
email :: Text -> Markdown
email = Markdown $ Just Email