mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-06-05 08:02:08 +00:00
Merge branch 'stable'
This commit is contained in:
@@ -1053,6 +1053,7 @@ data GroupLinkPlan
|
||||
| GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
|
||||
| GLPKnown {groupInfo :: GroupInfo, groupUpdated :: BoolDef, ownerVerification :: Maybe OwnerVerification, linkOwners :: ListDef GroupLinkOwner}
|
||||
| GLPNoRelays {groupSLinkData_ :: Maybe GroupShortLinkData}
|
||||
| GLPUpdateRequired {groupSLinkData_ :: Maybe GroupShortLinkData}
|
||||
deriving (Show)
|
||||
|
||||
data GroupLinkOwner = GroupLinkOwner
|
||||
@@ -1098,6 +1099,7 @@ connectionPlanProceed = \case
|
||||
GLPOwnLink _ -> True
|
||||
GLPConnectingConfirmReconnect -> True
|
||||
GLPNoRelays _ -> False
|
||||
GLPUpdateRequired _ -> False
|
||||
_ -> False
|
||||
CPError _ -> True
|
||||
|
||||
|
||||
@@ -4132,21 +4132,25 @@ processChatCommand vr nm = \case
|
||||
Nothing -> do
|
||||
(fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays})) <- getShortLinkConnReq' nm user l'
|
||||
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
if not direct && null relays
|
||||
then pure (con (linkConnReq fd), CPGroupLink (GLPNoRelays groupSLinkData_))
|
||||
else do
|
||||
let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd
|
||||
linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId}
|
||||
let profilePGId = groupSLinkData_ >>= \GroupShortLinkData {groupProfile = GroupProfile {publicGroup}} ->
|
||||
fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId) publicGroup
|
||||
case (B64UrlByteString <$> linkEntityId, profilePGId) of
|
||||
(Just entityId, Just publicGroupId) | entityId == publicGroupId -> pure ()
|
||||
(Nothing, Nothing) -> pure ()
|
||||
_ -> throwChatError CEInvalidConnReq
|
||||
let ov = verifyLinkOwner rootKey owners l' sig_
|
||||
plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov
|
||||
pure (con cReq, plan)
|
||||
if
|
||||
| not direct && unsupportedGroupType groupSLinkData_ -> pure (con (linkConnReq fd), CPGroupLink (GLPUpdateRequired groupSLinkData_))
|
||||
| not direct && null relays -> pure (con (linkConnReq fd), CPGroupLink (GLPNoRelays groupSLinkData_))
|
||||
| otherwise -> do
|
||||
let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd
|
||||
linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId}
|
||||
let profilePGId = groupSLinkData_ >>= \GroupShortLinkData {groupProfile = GroupProfile {publicGroup}} ->
|
||||
fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId) publicGroup
|
||||
case (B64UrlByteString <$> linkEntityId, profilePGId) of
|
||||
(Just entityId, Just publicGroupId) | entityId == publicGroupId -> pure ()
|
||||
(Nothing, Nothing) -> pure ()
|
||||
_ -> throwChatError CEInvalidConnReq
|
||||
let ov = verifyLinkOwner rootKey owners l' sig_
|
||||
plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov
|
||||
pure (con cReq, plan)
|
||||
where
|
||||
unsupportedGroupType = \case
|
||||
Just GroupShortLinkData {groupProfile = GroupProfile {publicGroup = Just PublicGroupProfile {groupType}}} -> groupType /= GTChannel
|
||||
_ -> False
|
||||
knownLinkPlans = withFastStore $ \db ->
|
||||
liftIO (getGroupInfoViaUserShortLink db vr user l') >>= \case
|
||||
Just (cReq, g) -> pure $ Just (con cReq, CPGroupLink (GLPOwnLink g))
|
||||
@@ -5567,17 +5571,25 @@ mkValidName :: String -> String
|
||||
mkValidName = dropWhileEnd isSpace . take 50 . reverse . fst3 . foldl' addChar ("", '\NUL', 0 :: Int)
|
||||
where
|
||||
fst3 (x, _, _) = x
|
||||
addChar (r, prev, punct) c = if validChar then (c' : r, c', punct') else (r, prev, punct)
|
||||
addChar (r, prev, punct) c' = if validChar then (c : r, c, punct') else (r, prev, punct)
|
||||
where
|
||||
c' = if isSpace c then ' ' else c
|
||||
c = if isSpace c' then ' ' else c'
|
||||
cat = generalCategory c
|
||||
isPunct = case cat of
|
||||
ConnectorPunctuation -> True
|
||||
DashPunctuation -> True
|
||||
OtherPunctuation -> True
|
||||
_ -> False
|
||||
punct'
|
||||
| isPunctuation c = punct + 1
|
||||
| isSpace c = punct
|
||||
| isPunct = punct + 1
|
||||
| c == ' ' = punct
|
||||
| otherwise = 0
|
||||
validChar
|
||||
| c == '\'' = False
|
||||
| prev == '\NUL' = c > ' ' && c /= '#' && c /= '@' && validFirstChar
|
||||
| isSpace prev = validFirstChar || (punct == 0 && isPunctuation c)
|
||||
| isPunctuation prev = validFirstChar || isSpace c || (punct < 3 && isPunctuation c)
|
||||
| otherwise = validFirstChar || isSpace c || isMark c || isPunctuation c
|
||||
validFirstChar = isLetter c || isNumber c || isSymbol c
|
||||
| c `elem` prohibited = False
|
||||
| prev == '\NUL' = c > ' ' && validFirstNameChar
|
||||
| prev == ' ' = validFirstChar || (punct == 0 && isPunct)
|
||||
| punct > 0 = validFirstChar || c == ' '
|
||||
| otherwise = validFirstChar || c == ' ' || isMark c || isPunct
|
||||
validFirstNameChar = isLetter c || cat == DecimalNumber || cat == OtherSymbol
|
||||
validFirstChar = validFirstNameChar || cat == CurrencySymbol || cat == MathSymbol
|
||||
prohibited = ".,;/\\#@'\"`~" :: String
|
||||
|
||||
@@ -35,11 +35,11 @@ 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 (..), SimplexNameInfo (..), simplexConnReqUri, simplexShortLink)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (ProtocolServer (..))
|
||||
import Simplex.Messaging.Util (decodeJSON, safeDecodeUtf8, tshow)
|
||||
import Simplex.Messaging.Util (decodeJSON, safeDecodeUtf8, tshow, (<$?>))
|
||||
import System.Console.ANSI.Types
|
||||
import qualified Text.Email.Validate as Email
|
||||
import qualified URI.ByteString as U
|
||||
@@ -59,6 +59,7 @@ data Format
|
||||
-- showText is Nothing for the usual Uri without text
|
||||
| HyperLink {showText :: Maybe Text, linkUri :: Text}
|
||||
| SimplexLink {showText :: Maybe Text, linkType :: SimplexLinkType, simplexUri :: AConnectionLink, smpHosts :: NonEmpty Text}
|
||||
| SimplexName {nameInfo :: SimplexNameInfo}
|
||||
| Command {commandStr :: Text}
|
||||
| Mention {memberName :: Text}
|
||||
| Email
|
||||
@@ -184,6 +185,7 @@ isLink = \case
|
||||
Uri -> True
|
||||
HyperLink {} -> True
|
||||
SimplexLink {} -> True
|
||||
SimplexName {} -> True
|
||||
_ -> False
|
||||
|
||||
hasLinks :: MarkdownList -> Bool
|
||||
@@ -202,9 +204,9 @@ markdownP = mconcat <$> A.many' fragmentP
|
||||
'_' -> formattedP '_' Italic
|
||||
'~' -> formattedP '~' StrikeThrough
|
||||
'`' -> formattedP '`' Snippet
|
||||
'#' -> A.char '#' *> secretP
|
||||
'#' -> A.char '#' *> (secretP <|> nameRefP '#' <|> secretFallback)
|
||||
'!' -> styledP <|> wordP
|
||||
'@' -> mentionP <|> wordP
|
||||
'@' -> (A.char '@' *> nameRefP '@') <|> mentionP <|> wordP
|
||||
'/' -> commandP <|> wordP
|
||||
'[' -> sowLinkP <|> wordP
|
||||
_
|
||||
@@ -221,14 +223,29 @@ markdownP = mconcat <$> A.many' fragmentP
|
||||
unmarked $ c `T.cons` s `T.snoc` c
|
||||
| otherwise = markdown f s
|
||||
secretP :: Parser Markdown
|
||||
secretP = secret <$> A.takeWhile (== '#') <*> A.takeTill (== '#') <*> A.takeWhile (== '#')
|
||||
secret :: Text -> Text -> Text -> Markdown
|
||||
secret b s a
|
||||
| T.null a || T.null s || T.head s == ' ' || T.last s == ' ' =
|
||||
unmarked $ '#' `T.cons` ss
|
||||
| otherwise = markdown Secret $ T.init ss
|
||||
secretP = secret <$?> ((,,) <$> A.takeWhile (== '#') <*> A.takeTill (== '#') <*> A.takeWhile1 (== '#'))
|
||||
secret :: (Text, Text, Text) -> Either String Markdown
|
||||
secret (b, s, a)
|
||||
| T.null s || T.head s == ' ' || T.last s == ' ' = Left "not secret"
|
||||
| otherwise = Right $ markdown Secret $ T.init ss
|
||||
where
|
||||
ss = b <> s <> a
|
||||
secretFallback :: Parser Markdown
|
||||
secretFallback = unmarked . ('#' `T.cons`) <$> A.takeTill (== ' ')
|
||||
nameRefP :: Char -> Parser Markdown
|
||||
nameRefP pfx = nameRef <$?> A.takeTill (== ' ')
|
||||
where
|
||||
nameRef word
|
||||
| pfx == '@' && T.all (/= '.') name = Left "not a name"
|
||||
| otherwise = mkMd <$> strDecode (encodeUtf8 full)
|
||||
where
|
||||
(name, punct) = splitPunctuation word
|
||||
full = pfx `T.cons` name
|
||||
mkMd ni
|
||||
| T.null punct = md'
|
||||
| otherwise = md' :|: unmarked punct
|
||||
where
|
||||
md' = markdown (SimplexName ni) full
|
||||
styledP :: Parser Markdown
|
||||
styledP = do
|
||||
f <- A.char '!' *> ((A.char '-' $> Small) <|> (colored <$> colorP)) <* A.space
|
||||
@@ -449,6 +466,7 @@ markdownText (FormattedText f_ t) = case f_ of
|
||||
Uri -> t
|
||||
HyperLink {} -> t
|
||||
SimplexLink {} -> t
|
||||
SimplexName {} -> t
|
||||
Mention _ -> t
|
||||
Command _ -> t
|
||||
Email -> t
|
||||
@@ -479,7 +497,6 @@ displayNameTextP_ = (,"") <$> quoted '\'' <|> splitPunctuation <$> takeNameTill
|
||||
takeNameTill p =
|
||||
A.peekChar' >>= \c ->
|
||||
if refChar c then A.takeTill p else fail "invalid first character in display name"
|
||||
splitPunctuation s = (T.dropWhileEnd isPunctuation s, T.takeWhileEnd isPunctuation s)
|
||||
quoted c = A.char c *> takeNameTill (== c) <* A.char c
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@' && c /= '\''
|
||||
|
||||
@@ -490,6 +507,9 @@ commandTextP = do
|
||||
(keyword : _) | T.all (\c -> isAlpha c || isDigit c || c == '_') keyword -> pure (cmd, punct)
|
||||
_ -> fail "invalid command keyword"
|
||||
|
||||
splitPunctuation :: Text -> (Text, Text)
|
||||
splitPunctuation s = (T.dropWhileEnd isPunctuation s, T.takeWhileEnd isPunctuation s)
|
||||
|
||||
-- quotes names that contain spaces or end on punctuation
|
||||
viewName :: Text -> Text
|
||||
viewName s = if T.any isSpace s || maybe False (isPunctuation . snd) (T.unsnoc s) then "'" <> s <> "'" else s
|
||||
|
||||
@@ -2150,6 +2150,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
|
||||
]
|
||||
knownGroup prepared = grpOrBizLink g <> ": known " <> prepared <> grpOrBiz g <> " " <> ttyGroup' g
|
||||
GLPNoRelays _ -> [grpLink "channel has no active relays, please try to join later"]
|
||||
GLPUpdateRequired _ -> [grpLink "this group requires a newer version of the app, please upgrade"]
|
||||
where
|
||||
connecting g = [grpOrBizLink g <> ": connecting to " <> grpOrBiz g <> " " <> ttyGroup' g]
|
||||
grpLink = ("group link: " <>)
|
||||
|
||||
Reference in New Issue
Block a user