allow SimpleX links with link text

src/Simplex/Chat/Markdown.hs

@@ -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

tests/MarkdownTests.hs

@@ -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