core: fix uri parse to not include trailing punctuation in URIs (#3296)

* core: fix uri parse to not include trailing punctuation in URIs

* simplify

src/Simplex/Chat/Markdown.hs

@@ -14,7 +14,7 @@ import Data.Aeson (ToJSON)
 import qualified Data.Aeson as J
 import Data.Attoparsec.Text (Parser)
 import qualified Data.Attoparsec.Text as A
-import Data.Char (isDigit)
+import Data.Char (isDigit, isPunctuation)
 import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.List (intercalate, foldl')
@@ -217,11 +217,15 @@ markdownP = mconcat <$> A.many' fragmentP
     wordMD :: Text -> Markdown
     wordMD s
       | T.null s = unmarked s
-      | isUri s = case strDecode $ encodeUtf8 s of
-        Right cReq -> markdown (simplexUriFormat cReq) s
-        _ -> markdown Uri s
+      | isUri s =
+        let t = T.takeWhileEnd isPunctuation s
+            uri = uriMarkdown $ T.dropWhileEnd isPunctuation s
+         in if T.null t then uri else uri :|: unmarked t
       | isEmail s = markdown Email s
       | otherwise = unmarked s
+    uriMarkdown s = case strDecode $ encodeUtf8 s of
+      Right cReq -> markdown (simplexUriFormat cReq) s
+      _ -> markdown Uri s
     isUri s = T.length s >= 10 && any (`T.isPrefixOf` s) ["http://", "https://", "simplex:/"]
     isEmail s = T.any (== '@') s && Email.isValid (encodeUtf8 s)
     noFormat = pure . unmarked

tests/MarkdownTests.hs

@@ -144,6 +144,8 @@ textWithUri :: Spec
 textWithUri = describe "text with Uri" do
   it "correct markdown" do
     parseMarkdown "https://simplex.chat" `shouldBe` uri "https://simplex.chat"
+    parseMarkdown "https://simplex.chat." `shouldBe` uri "https://simplex.chat" <> "."
+    parseMarkdown "https://simplex.chat, hello" `shouldBe` uri "https://simplex.chat" <> ", hello"
     parseMarkdown "http://simplex.chat" `shouldBe` uri "http://simplex.chat"
     parseMarkdown "this is https://simplex.chat" `shouldBe` "this is " <> uri "https://simplex.chat"
     parseMarkdown "https://simplex.chat site" `shouldBe` uri "https://simplex.chat" <> " site"