mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-14 06:05:26 +00:00
core: markdown for simplex invitation links (#1408)
* core: markdown for simplex invitation links * update markdown for simplex links * update markdown * update * stabilize test
This commit is contained in:
committed by
GitHub
parent
388aaec80b
commit
a7345ee4d9
@@ -1,5 +1,7 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
|
||||
@@ -16,13 +18,21 @@ import Data.Char (isDigit)
|
||||
import Data.Either (fromRight)
|
||||
import Data.Functor (($>))
|
||||
import Data.List (intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe, isNothing)
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import GHC.Generics
|
||||
import Simplex.Messaging.Parsers (fstToLower, sumTypeJSON)
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ConnReqScheme (..), ConnReqUriData (..), ConnectionRequestUri (..), SMPQueue (..))
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (ProtocolServer (..))
|
||||
import Simplex.Messaging.Util (safeDecodeUtf8)
|
||||
import System.Console.ANSI.Types
|
||||
import qualified Text.Email.Validate as Email
|
||||
|
||||
@@ -37,17 +47,27 @@ data Format
|
||||
| Secret
|
||||
| Colored {color :: FormatColor}
|
||||
| Uri
|
||||
| SimplexLink {linkType :: SimplexLinkType, simplexUri :: Text, smpHosts :: NonEmpty Text}
|
||||
| Email
|
||||
| Phone
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
data SimplexLinkType = XLContact | XLInvitation | XLGroup
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON SimplexLinkType where
|
||||
toJSON = J.genericToJSON . enumJSON $ dropPrefix "XL"
|
||||
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "XL"
|
||||
|
||||
colored :: Color -> Format
|
||||
colored = Colored . FormatColor
|
||||
|
||||
markdown :: Format -> Text -> Markdown
|
||||
markdown = Markdown . Just
|
||||
|
||||
instance ToJSON Format where toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
|
||||
instance ToJSON Format where
|
||||
toJSON = J.genericToJSON $ sumTypeJSON fstToLower
|
||||
toEncoding = J.genericToEncoding $ sumTypeJSON fstToLower
|
||||
|
||||
instance Semigroup Markdown where
|
||||
m <> (Markdown _ "") = m
|
||||
@@ -190,9 +210,24 @@ markdownP = mconcat <$> A.many' fragmentP
|
||||
wordMD :: Text -> Markdown
|
||||
wordMD s
|
||||
| T.null s = unmarked s
|
||||
| isUri s = markdown Uri s
|
||||
| isUri s = case strDecode $ encodeUtf8 s of
|
||||
Right cReq -> markdown (simplexUriFormat cReq) s
|
||||
_ -> markdown Uri s
|
||||
| isEmail s = markdown Email s
|
||||
| otherwise = unmarked 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
|
||||
simplexUriFormat :: AConnectionRequestUri -> Format
|
||||
simplexUriFormat = \case
|
||||
ACR _ (CRContactUri crData) ->
|
||||
let uri = safeDecodeUtf8 . strEncode $ CRContactUri crData {crScheme = CRSSimplex}
|
||||
in SimplexLink (linkType' crData) uri $ uriHosts crData
|
||||
ACR _ (CRInvitationUri crData e2e) ->
|
||||
let uri = safeDecodeUtf8 . strEncode $ CRInvitationUri crData {crScheme = CRSSimplex} e2e
|
||||
in SimplexLink XLInvitation uri $ uriHosts crData
|
||||
where
|
||||
uriHosts ConnReqUriData {crSmpQueues} = L.map (safeDecodeUtf8 . strEncode) $ sconcat $ L.map (host . qServer) crSmpQueues
|
||||
linkType' ConnReqUriData {crClientData} = case crClientData >>= decodeJSON of
|
||||
Just (CRDataGroup _) -> XLGroup
|
||||
Nothing -> XLContact
|
||||
|
||||
@@ -2237,6 +2237,7 @@ testUserContactLinkAutoAccept =
|
||||
concurrently_
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
threadDelay 100000
|
||||
alice @@@ [("@bob", "Voice messages: enabled")]
|
||||
alice <##> bob
|
||||
|
||||
@@ -2249,6 +2250,7 @@ testUserContactLinkAutoAccept =
|
||||
concurrently_
|
||||
(cath <## "alice (Alice): contact is connected")
|
||||
(alice <## "cath (Catherine): contact is connected")
|
||||
threadDelay 100000
|
||||
alice @@@ [("@cath", "Voice messages: enabled"), ("@bob", "hey")]
|
||||
alice <##> cath
|
||||
|
||||
@@ -2263,6 +2265,7 @@ testUserContactLinkAutoAccept =
|
||||
concurrently_
|
||||
(dan <## "alice (Alice): contact is connected")
|
||||
(alice <## "dan (Daniel): contact is connected")
|
||||
threadDelay 100000
|
||||
alice @@@ [("@dan", "Voice messages: enabled"), ("@cath", "hey"), ("@bob", "hey")]
|
||||
alice <##> dan
|
||||
|
||||
@@ -2989,6 +2992,7 @@ testUpdateGroupPrefs =
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "full message deletion enabled: on"
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on")])
|
||||
threadDelay 1000000
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"off\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "full message deletion enabled: off"
|
||||
@@ -2999,6 +3003,7 @@ testUpdateGroupPrefs =
|
||||
bob <## "full message deletion enabled: off"
|
||||
bob <## "voice messages enabled: off"
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off")])
|
||||
threadDelay 1000000
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "voice messages enabled: on"
|
||||
@@ -3007,6 +3012,7 @@ testUpdateGroupPrefs =
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "voice messages enabled: on"
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off"), (0, "Voice messages: on")])
|
||||
threadDelay 1000000
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}}}"
|
||||
-- no update
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")])
|
||||
|
||||
@@ -1,8 +1,11 @@
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module MarkdownTests where
|
||||
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Text (Text)
|
||||
import Simplex.Chat.Markdown
|
||||
import System.Console.ANSI.Types
|
||||
@@ -134,6 +137,9 @@ textColor = describe "text color (red)" do
|
||||
uri :: Text -> Markdown
|
||||
uri = Markdown $ Just Uri
|
||||
|
||||
simplexLink :: SimplexLinkType -> Text -> NonEmpty Text -> Text -> Markdown
|
||||
simplexLink linkType simplexUri smpHosts = Markdown $ Just SimplexLink {linkType, simplexUri, smpHosts}
|
||||
|
||||
textWithUri :: Spec
|
||||
textWithUri = describe "text with Uri" do
|
||||
it "correct markdown" do
|
||||
@@ -144,6 +150,13 @@ textWithUri = describe "text with Uri" do
|
||||
it "ignored as markdown" do
|
||||
parseMarkdown "_https://simplex.chat" `shouldBe` "_https://simplex.chat"
|
||||
parseMarkdown "this is _https://simplex.chat" `shouldBe` "this is _https://simplex.chat"
|
||||
it "SimpleX links" do
|
||||
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%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
|
||||
parseMarkdown ("https://simplex.chat" <> inv) `shouldBe` simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] ("https://simplex.chat" <> inv)
|
||||
let ct = "/contact#/?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"
|
||||
parseMarkdown ("https://simplex.chat" <> ct) `shouldBe` simplexLink XLContact ("simplex:" <> ct) ["smp.simplex.im"] ("https://simplex.chat" <> ct)
|
||||
let gr = "/contact#/?v=1-2&smp=smp%3A%2F%2Fu2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU%3D%40smp4.simplex.im%2FWHV0YU1sYlU7NqiEHkHDB6gxO1ofTync%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAWbebOqVYuBXaiqHcXYjEHCpYi6VzDlu6CVaijDTmsQU%253D%26srv%3Do5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion&data=%7B%22type%22%3A%22group%22%2C%22groupLinkId%22%3A%22mL-7Divb94GGmGmRBef5Dg%3D%3D%22%7D"
|
||||
parseMarkdown ("https://simplex.chat" <> gr) `shouldBe` simplexLink XLGroup ("simplex:" <> gr) ["smp4.simplex.im", "o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"] ("https://simplex.chat" <> gr)
|
||||
|
||||
email :: Text -> Markdown
|
||||
email = Markdown $ Just Email
|
||||
|
||||
Reference in New Issue
Block a user