core, ui: resolve untyped domains (#7198)

* core: resolve untyped domains

* CPError

* only add domain when it has link of correct type

* resolve first

* handle errors

* remove CPError

* update UI types

* remove unused name

Co-authored-by: Evgeny <evgeny@poberezkin.com>

* refactor connection plan

* kotlin: show domain and alternative chat, haskell tests for dual domains

* view/tests

* update kotlin

* dual domains accounting for business chats

* refactor, fix

* fix kotlin

* remove comment

* search

* add resolve mode

* local resolution

* refactor, bot types

* search both contact and channel by name

* fix

* fix searching business chats by name

* fix ui

* ios

* fix ios

* fix icon

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny
2026-07-06 08:50:03 +01:00
committed by GitHub
co-authored by Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
parent ff58dbd6df
commit 6150b35a2f
34 changed files with 934 additions and 253 deletions
+22 -5
View File
@@ -529,7 +529,7 @@ data ChatCommand
| AddContact IncognitoEnabled
| APISetConnectionIncognito Int64 IncognitoEnabled
| APIChangeConnectionUser Int64 UserId -- new user id to switch connection to
| APIConnectPlan {userId :: UserId, connectTarget :: Maybe AConnectTarget, resolveKnown :: Bool, linkOwnerSig :: Maybe LinkOwnerSig} -- Maybe AConnectTarget is used to report parsing failure as special error
| APIConnectPlan {userId :: UserId, connectTarget :: Maybe AConnectTarget, resolveMode :: PlanResolveMode, linkOwnerSig :: Maybe LinkOwnerSig} -- Maybe AConnectTarget is used to report parsing failure as special error
| APIPrepareContact UserId ACreatedConnLink (Maybe SimplexDomain) ContactShortLinkData
| APIPrepareGroup UserId CreatedLinkContact DirectLink (Maybe SimplexDomain) GroupShortLinkData
| APIChangePreparedContactUser ContactId UserId
@@ -670,6 +670,22 @@ data ChatCommand
CustomChatCommand ByteString
deriving (Show)
data PlanResolveMode
= PRMAllGroups -- resolve all known groups and all unknown chats
| PRMUnknown -- only resolve if chat is unknown (default)
| PRMNever -- do not resolve links and names, only do local search
deriving (Eq, Show)
planResolveModeP :: A.Parser PlanResolveMode
planResolveModeP =
A.takeTill (== ' ') >>= \case
"allGroups" -> pure PRMAllGroups
"on" -> pure PRMAllGroups
"unknown" -> pure PRMUnknown
"off" -> pure PRMUnknown
"never" -> pure PRMNever
_ -> fail "bad PlanResolveMode"
allowRemoteCommand :: ChatCommand -> Bool -- XXX: consider using Relay/Block/ForceLocal
allowRemoteCommand = \case
StartChat {} -> False
@@ -820,7 +836,7 @@ data ChatResponse
| CRInvitation {user :: User, connLinkInvitation :: CreatedLinkInvitation, connection :: PendingContactConnection}
| CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection, customUserProfile :: Maybe Profile}
| CRConnectionUserChanged {user :: User, fromConnection :: PendingContactConnection, toConnection :: PendingContactConnection, newUser :: User}
| CRConnectionPlan {user :: User, connLink :: ACreatedConnLink, connectionPlan :: ConnectionPlan}
| CRConnectionPlan {user :: User, connLink :: ACreatedConnLink, planSimplexName :: Maybe SimplexNameInfo, otherSimplexName :: Maybe SimplexNameInfo, connectionPlan :: ConnectionPlan}
| CRNewPreparedChat {user :: User, chat :: AChat}
| CRContactUserChanged {user :: User, fromContact :: Contact, newUser :: User, toContact :: Contact}
| CRGroupUserChanged {user :: User, fromGroup :: GroupInfo, newUser :: User, toGroup :: GroupInfo}
@@ -1096,7 +1112,7 @@ data InvitationLinkPlan
deriving (Show)
data ContactAddressPlan
= CAPOk {contactSLinkData_ :: Maybe ContactShortLinkData, ownerVerification :: Maybe OwnerVerification, verifiedDomain :: Maybe SimplexDomain}
= CAPOk {contactSLinkData_ :: Maybe ContactShortLinkData, ownerVerification :: Maybe OwnerVerification}
| CAPOwnLink
| CAPConnectingConfirmReconnect
| CAPConnectingProhibit {contact :: Contact}
@@ -1105,11 +1121,11 @@ data ContactAddressPlan
deriving (Show)
data GroupLinkPlan
= GLPOk {groupSLinkInfo_ :: Maybe GroupShortLinkInfo, groupSLinkData_ :: Maybe GroupShortLinkData, ownerVerification :: Maybe OwnerVerification, verifiedDomain :: Maybe SimplexDomain}
= GLPOk {groupSLinkInfo_ :: Maybe GroupShortLinkInfo, groupSLinkData_ :: Maybe GroupShortLinkData, ownerVerification :: Maybe OwnerVerification}
| GLPOwnLink {groupInfo :: GroupInfo}
| GLPConnectingConfirmReconnect
| GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
| GLPKnown {groupInfo :: GroupInfo, groupUpdated :: BoolDef, ownerVerification :: Maybe OwnerVerification, linkOwners :: ListDef GroupLinkOwner}
| GLPKnown {groupInfo :: GroupInfo, groupUpdated :: Bool, ownerVerification :: Maybe OwnerVerification, linkOwners :: ListDef GroupLinkOwner}
| GLPNoRelays {groupSLinkData_ :: Maybe GroupShortLinkData}
| GLPUpdateRequired {groupSLinkData_ :: Maybe GroupShortLinkData}
deriving (Show)
@@ -1433,6 +1449,7 @@ data ChatErrorType
| CEChatStoreChanged
| CEInvalidConnReq
| CESimplexDomainNotReady {simplexDomain :: SimplexDomain, simplexDomainError :: SimplexDomainError}
| CENotResolvedLocally -- a name or link is not a known chat in the local store and online resolution is off (PRMNever)
| CEUnsupportedConnReq
| CEInvalidChatMessage {connection :: Connection, msgMeta :: Maybe MsgMetaJSON, messageData :: Text, message :: String}
| CEConnReqMessageProhibited
+108 -66
View File
@@ -2058,8 +2058,9 @@ processChatCommand cxt nm = \case
createDirectConnection db newUser agConnId ccLink' Nothing ConnNew Nothing subMode initialChatVersion PQSupportOn
deleteAgentConnectionAsync (aConnId' conn)
pure conn'
APIConnectPlan userId (Just ct) resolveKnown linkOwnerSig_ -> withUserId userId $ \user ->
uncurry (CRConnectionPlan user) <$> connectPlan user ct resolveKnown linkOwnerSig_
APIConnectPlan userId (Just ct) resolveMode linkOwnerSig_ -> withUserId userId $ \user -> do
(ccLink, planSimplexName, otherSimplexName, plan) <- connectPlan user ct resolveMode linkOwnerSig_ Nothing
pure $ CRConnectionPlan user ccLink planSimplexName otherSimplexName plan
APIConnectPlan _ Nothing _ _ -> throwChatError CEInvalidConnReq
APIPrepareContact userId accLink verifiedDomain contactSLinkData -> withUserId userId $ \user -> do
let ContactShortLinkData {profile, message, business} = contactSLinkData
@@ -2283,12 +2284,12 @@ processChatCommand cxt nm = \case
CVRSentInvitation conn incognitoProfile -> pure $ CRSentInvitation user (mkPendingContactConnection conn Nothing) incognitoProfile
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
Connect incognito (Just ct) -> withUser $ \user -> do
let con m cReq = pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing Nothing))
(ccLink, plan) <- connectPlan user ct False Nothing `catchAllErrors` \e -> case ct of
let con m cReq = pure (ACCL m (CCLink cReq Nothing), Nothing, Nothing, CPInvitationLink (ILPOk Nothing Nothing))
(ccLink, planSimplexName, otherSimplexName, plan) <- connectPlan user ct PRMUnknown Nothing Nothing `catchAllErrors` \e -> case ct of
ACTarget m (CTFullContact cReq) -> con m cReq
ACTarget m (CTInv (CLFull cReq)) -> con m cReq
_ -> throwError e
connectWithPlan user incognito ccLink plan
connectWithPlan user incognito ccLink planSimplexName otherSimplexName plan
Connect _ Nothing -> throwChatError CEInvalidConnReq
APIVerifyContactDomain contactId -> withUser $ \user -> do
ct@Contact {profile = LocalProfile {contactDomain}, preparedContact} <- withFastStore $ \db -> getContact db cxt user contactId
@@ -2319,8 +2320,8 @@ processChatCommand cxt nm = \case
toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
throwError e
ConnectSimplex incognito -> withUser $ \user -> do
plan <- contactRequestPlan user adminContactReq Nothing Nothing `catchAllErrors` const (pure $ CPContactAddress (CAPOk Nothing Nothing Nothing))
connectWithPlan user incognito (ACCL SCMContact (CCLink adminContactReq Nothing)) plan
plan <- contactRequestPlan user adminContactReq Nothing Nothing `catchAllErrors` const (pure $ CPContactAddress (CAPOk Nothing Nothing))
connectWithPlan user incognito (ACCL SCMContact (CCLink adminContactReq Nothing)) Nothing Nothing plan
DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId Nothing) cdm
ClearContact cName -> withContactName cName $ \chatId -> APIClearChat $ ChatRef CTDirect chatId Nothing
APIListContacts userId -> withUserId userId $ \user ->
@@ -4178,13 +4179,13 @@ processChatCommand cxt nm = \case
pure (gId, chatSettings)
_ -> throwCmdError "not supported"
processChatCommand cxt nm $ APISetChatSettings (ChatRef cType chatId Nothing) $ updateSettings chatSettings
connectPlan :: User -> AConnectTarget -> Bool -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan)
connectPlan user (ACTarget SCMInvitation (CTInv cLink)) _ sig_ = case cLink of
connectPlan :: User -> AConnectTarget -> PlanResolveMode -> Maybe LinkOwnerSig -> Maybe (Either ChatError NameRecord) -> CM (ACreatedConnLink, Maybe SimplexNameInfo, Maybe SimplexNameInfo, ConnectionPlan)
connectPlan user (ACTarget SCMInvitation (CTInv cLink)) _ sig_ _ = case cLink of
CLFull cReq -> invitationReqAndPlan cReq Nothing Nothing Nothing
CLShort l -> do
let l' = serverShortLink l
knownLinkPlans l' >>= \case
Just r -> pure r
Just (l, p) -> pure (l, Nothing, Nothing, p)
Nothing -> do
(FixedLinkData {linkConnReq = cReq, rootKey}, cData) <- getShortLinkConnReq nm user l'
contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData)
@@ -4199,27 +4200,56 @@ processChatCommand cxt nm = \case
Nothing -> bimap inv (CPInvitationLink . ILPKnown) <$$> getContactViaShortLinkToConnect db cxt user l'
invitationReqAndPlan cReq sLnk_ cld ov = do
plan <- invitationRequestPlan user cReq cld ov `catchAllErrors` (pure . CPError)
pure (ACCL SCMInvitation (CCLink cReq sLnk_), plan)
connectPlan user (ACTarget SCMContact ct) resolveKnown sig_ = case ct of
pure (ACCL SCMInvitation (CCLink cReq sLnk_), Nothing, Nothing, plan)
connectPlan user (ACTarget SCMContact ct) resolveMode sig_ nameRec = case ct of
CTDomain d
-- local search only: look up #d then @d in the store, without online name resolution
| resolveMode == PRMNever -> connectPlanNoName $ ChatError CENotResolvedLocally
| otherwise ->
tryAllErrors (withAgent $ \a -> resolveSimplexName a nm (aUserId user) d) >>= \case
Right nr
| isJust (firstNameLink CCTChannel (nrSimplexChannel nr)) ->
(addOther nr <$> connectPlanName NTPublicGroup (Right nr)) `catchAllErrors` \e ->
(addOther nr <$> connectPlanName NTContact (Right nr) `catchAllErrors` \_ -> throwError e)
| isJust (firstNameLink CCTContact (nrSimplexContact nr)) ->
addOther nr <$> connectPlanName NTContact (Right nr)
| otherwise -> connectPlanNoName $ ChatError $ CESimplexDomainNotReady d SDENoValidLink
Left e -> connectPlanNoName e
where
connectPlanName nameType nr_ = connectPlan user connTarget resolveMode sig_ (Just nr_)
where
connTarget = ACTarget SCMContact $ CTShortContact $ CTName $ SimplexNameInfo nameType d
connectPlanNoName e =
connectPlanName NTPublicGroup (Left e) `catchAllErrors` \e' ->
(connectPlanName NTContact (Left e) `catchAllErrors` \_ -> throwError e')
-- the same domain can resolve to both an @ name (contact or business) and a # channel;
-- keyed off the resolved name's type, so a contact name returning a business group still offers the channel
addOther nr (l, planName, _, p) = (l, planName, otherName, p)
where
otherName = case planName of
Just (SimplexNameInfo NTContact _) | isJust (firstNameLink CCTChannel (nrSimplexChannel nr)) -> Just $ SimplexNameInfo NTPublicGroup d
Just (SimplexNameInfo NTPublicGroup _) | isJust (firstNameLink CCTContact (nrSimplexContact nr)) -> Just $ SimplexNameInfo NTContact d
_ -> Nothing
CTFullContact cReq -> do
plan <- contactOrGroupRequestPlan user cReq `catchAllErrors` (pure . CPError)
pure (ACCL SCMContact $ CCLink cReq Nothing, plan)
pure (ACCL SCMContact $ CCLink cReq Nothing, Nothing, Nothing, plan)
CTShortContact nl ->
case ctType of
(\(l, p) -> (l, simplexName_, Nothing, p)) <$> case ctType of
CCTContact ->
knownLinkPlans >>= \case
Just r -> pure r
Nothing -> do
when (resolveMode == PRMNever) $ throwChatError CENotResolvedLocally
l' <- resolveSLink
(FixedLinkData {linkConnReq = cReq, rootKey}, cData) <- getShortLinkConnReq nm user l'
contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData)
let linkProfile_ = (\ContactShortLinkData {profile} -> profile) <$> contactSLinkData_
linkDomain_ = linkProfile_ >>= \Profile {contactDomain} -> claimDomain <$> contactDomain
verifiedDomain = case nl of CTName ni -> Just (nameDomain ni); _ -> Nothing
refreshContact ct' = case (verifiedDomain, linkProfile_) of
planDomain = case nl of CTName ni -> Just (nameDomain ni); _ -> Nothing
refreshContact ct' = case (planDomain, linkProfile_) of
(Just _, Just p) -> updateContactFromLinkData user ct' p
_ -> pure ct'
forM_ verifiedDomain $ \nameDomain ->
forM_ planDomain $ \nameDomain ->
unless (linkDomain_ == Just nameDomain) $ throwChatError $ CESimplexDomainNotReady nameDomain SDEUnknownDomain
withFastStore' (\db -> getContactWithoutConnViaShortAddress db cxt user l') >>= \case
Just ct' | not (contactDeleted ct') -> do
@@ -4230,15 +4260,15 @@ processChatCommand cxt nm = \case
ov = verifyLinkOwner rootKey owners l' sig_
plan <- contactRequestPlan user cReq contactSLinkData_ ov
case plan of
CPContactAddress cap@(CAPOk {}) -> pure (con l' cReq, CPContactAddress cap {verifiedDomain})
CPContactAddress (CAPKnown ct') -> do
ct'' <- refreshContact ct'
pure (con l' cReq, CPContactAddress (CAPKnown ct''))
pure (con l' cReq, plan {contactAddressPlan = CAPKnown ct''})
CPContactAddress (CAPContactViaAddress ct') -> do
ct'' <- refreshContact ct'
pure (con l' cReq, CPContactAddress (CAPContactViaAddress ct''))
pure (con l' cReq, plan {contactAddressPlan = CAPContactViaAddress ct''})
_ -> pure (con l' cReq, plan)
where
knownLinkPlans :: CM (Maybe (ACreatedConnLink, ConnectionPlan))
knownLinkPlans = withFastStore $ \db ->
liftIO (getUserContactLinkViaTarget db user nl') >>= \case
Just UserContactLink {connLinkContact} -> pure $ Just (ACCL SCMContact connLinkContact, CPContactAddress CAPOwnLink)
@@ -4250,24 +4280,26 @@ processChatCommand cxt nm = \case
CCTChannel -> groupShortLinkPlan
CCTRelay -> throwCmdError "chat relay links are not supported in this version"
where
nl' = case nl of
CTLink sl -> CTLink (serverShortLink sl)
CTName _ -> nl
(nl', simplexName_) = case nl of
CTLink sl -> (CTLink (serverShortLink sl), Nothing)
CTName ni -> (nl, Just ni)
ctType = case nl of
CTLink (CSLContact _ t _ _) -> t
CTName SimplexNameInfo {nameType = NTContact} -> CCTContact
CTName SimplexNameInfo {nameType = NTPublicGroup} -> CCTChannel
resolveSLink = case nl' of
CTLink l' -> pure l'
CTName n -> serverShortLink <$> resolveNameLink user n
CTName n -> serverShortLink <$> resolveNameLink n
con l' cReq = ACCL SCMContact $ CCLink cReq (Just l')
gPlan (ccl, g) = if memberRemoved (membership g) then Nothing else Just (ACCL SCMContact ccl, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef [])))
gPlan (ccl, g) = if memberRemoved (membership g) then Nothing else Just (ACCL SCMContact ccl, CPGroupLink (GLPKnown g False Nothing (ListDef [])))
groupShortLinkPlan :: CM (ACreatedConnLink, ConnectionPlan)
groupShortLinkPlan =
knownLinkPlans >>= \case
Just (_, CPGroupLink (GLPKnown g _ _ _))
| resolveKnown -> resolveKnownGroup g
| resolveMode == PRMAllGroups -> resolveKnownGroup g
Just r -> pure r
Nothing -> do
when (resolveMode == PRMNever) $ throwChatError CENotResolvedLocally
l' <- resolveSLink
(fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays})) <- getShortLinkConnReq' nm user l'
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
@@ -4284,23 +4316,29 @@ processChatCommand cxt nm = \case
(Nothing, Nothing) -> pure ()
_ -> throwChatError CEInvalidConnReq
let ov = verifyLinkOwner rootKey owners l' sig_
verifiedDomain = case nl of CTName ni -> Just (nameDomain ni); _ -> Nothing
plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov
forM_ verifiedDomain $ \nameDomain ->
planDomain = case nl of CTName ni -> Just (nameDomain ni); _ -> Nothing
plan0 <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov
-- a joined channel is found by link but not by name (its domain is not verified locally,
-- e.g. an un-upgraded relay dropped the claim); refresh its profile from the fresh link
-- data and mark it verified, so the check below passes and future by-name lookups match
plan <- case (planDomain, plan0, groupSLinkData_) of
(Just _, CPGroupLink (GLPKnown g u o os), Just sLinkData) ->
(\(g', _) -> CPGroupLink (GLPKnown g' u o os)) <$> updateGroupFromLinkData user g sLinkData
_ -> pure plan0
forM_ planDomain $ \nameDomain ->
let domain_ = (\GroupProfile {publicGroup} -> claimDomain <$> (publicGroup >>= publicGroupAccess >>= groupDomainClaim)) =<< case plan of
CPGroupLink (GLPOk _ (Just GroupShortLinkData {groupProfile}) _ _) -> Just groupProfile
CPGroupLink (GLPOk _ (Just GroupShortLinkData {groupProfile}) _) -> Just groupProfile
CPGroupLink (GLPKnown GroupInfo {groupProfile} _ _ _) -> Just groupProfile
CPGroupLink (GLPOwnLink GroupInfo {groupProfile}) -> Just groupProfile
CPGroupLink (GLPConnectingProhibit (Just GroupInfo {groupProfile})) -> Just groupProfile
_ -> (\GroupShortLinkData {groupProfile} -> groupProfile) <$> groupSLinkData_
in unless (domain_ == Just nameDomain) $ throwChatError $ CESimplexDomainNotReady nameDomain SDEUnknownDomain
pure $ case plan of
CPGroupLink glp@(GLPOk {}) -> (con l' cReq, CPGroupLink glp {verifiedDomain})
_ -> (con l' cReq, plan)
pure (con l' cReq, plan)
where
unsupportedGroupType = \case
Just GroupShortLinkData {groupProfile = GroupProfile {publicGroup = Just PublicGroupProfile {groupType}}} -> groupType /= GTChannel
_ -> False
knownLinkPlans :: CM (Maybe (ACreatedConnLink, ConnectionPlan))
knownLinkPlans = withFastStore $ \db ->
liftIO (getGroupInfoViaUserTarget db cxt user nl') >>= \case
Just (ccl, g) -> pure $ Just (ACCL SCMContact ccl, CPGroupLink (GLPOwnLink g))
@@ -4314,29 +4352,29 @@ processChatCommand cxt nm = \case
(g', updated) <- case groupSLinkData_ of
Just sLinkData -> updateGroupFromLinkData user g sLinkData
_ -> pure (g, False)
pure (con l' (linkConnReq fd), CPGroupLink (GLPKnown g' (BoolDef updated) ov (ListDef glOwners)))
-- resolve a name to its first contact/channel short link
resolveNameLink :: User -> SimplexNameInfo -> CM (ConnShortLink 'CMContact)
resolveNameLink user SimplexNameInfo {nameType, nameDomain} = do
NameRecord {nrSimplexContact, nrSimplexChannel} <-
withAgent $ \a -> resolveSimplexName a nm (aUserId user) nameDomain
let (candidates, ctType) = case nameType of
NTContact -> (nrSimplexContact, CCTContact)
NTPublicGroup -> (nrSimplexChannel, CCTChannel)
maybe (throwChatError $ CESimplexDomainNotReady nameDomain SDENoValidLink) pure $ firstNameLink ctType candidates
connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse
connectWithPlan user@User {userId} incognito ccLink plan
pure (con l' (linkConnReq fd), CPGroupLink (GLPKnown g' updated ov (ListDef glOwners)))
-- resolve a name to its first contact/channel short link
resolveNameLink :: SimplexNameInfo -> CM (ConnShortLink 'CMContact)
resolveNameLink SimplexNameInfo {nameType, nameDomain} = do
NameRecord {nrSimplexContact, nrSimplexChannel} <- maybe (withAgent $ \a -> resolveSimplexName a nm (aUserId user) nameDomain) (ExceptT . pure) nameRec
let (candidates, ctType') = case nameType of
NTContact -> (nrSimplexContact, CCTContact)
NTPublicGroup -> (nrSimplexChannel, CCTChannel)
maybe (throwChatError $ CESimplexDomainNotReady nameDomain SDENoValidLink) pure $ firstNameLink ctType' candidates
connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> Maybe SimplexNameInfo -> Maybe SimplexNameInfo -> ConnectionPlan -> CM ChatResponse
connectWithPlan user@User {userId} incognito ccLink planSimplexName otherSimplexName plan
| connectionPlanProceed plan = do
case plan of CPError e -> eToView e; _ -> pure ()
case plan of
CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
processChatCommand cxt nm $ APIConnectContactViaAddress userId incognito contactId
CPContactAddress (CAPOk (Just sld) _ vName@(Just _)) -> connectContactViaName sld vName
CPGroupLink (GLPOk (Just GroupShortLinkInfo {direct = False}) (Just gld) _ vName)
CPContactAddress (CAPOk (Just sld) _) | isJust vName -> connectContactViaName sld vName
CPGroupLink (GLPOk (Just GroupShortLinkInfo {direct = False}) (Just gld) _)
| ACCL SCMContact ccl <- ccLink -> joinChannelViaRelays ccl gld vName
_ -> processChatCommand cxt nm $ APIConnect userId incognito $ Just ccLink
| otherwise = pure $ CRConnectionPlan user ccLink plan
| otherwise = pure $ CRConnectionPlan user ccLink planSimplexName otherSimplexName plan
where
vName = nameDomain <$> planSimplexName
joinChannelViaRelays :: CreatedLinkContact -> GroupShortLinkData -> Maybe SimplexDomain -> CM ChatResponse
joinChannelViaRelays ccl gld vName = do
GroupInfo {groupId} <- prepareChannelGroup
@@ -4391,21 +4429,22 @@ processChatCommand cxt nm = \case
contactRequestPlan user (CRContactUri crData) cld ov = do
let cReqSchemas = contactCReqSchemas crData
cReqHashes = bimap contactCReqHash contactCReqHash cReqSchemas
plan p = pure $ CPContactAddress p
withFastStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case
Just _ -> pure $ CPContactAddress CAPOwnLink
Just _ -> plan $ CAPOwnLink
Nothing ->
withFastStore' (\db -> getContactConnEntityByConnReqHash db cxt user cReqHashes) >>= \case
Nothing ->
withFastStore' (\db -> getContactWithoutConnViaAddress db cxt user cReqSchemas) >>= \case
Just ct | not (contactDeleted ct) -> pure $ CPContactAddress (CAPContactViaAddress ct)
_ -> pure $ CPContactAddress (CAPOk cld ov Nothing)
Just ct | not (contactDeleted ct) -> plan $ CAPContactViaAddress ct
_ -> plan $ CAPOk cld ov
Just (RcvDirectMsgConnection Connection {connStatus} Nothing)
| connStatus == ConnPrepared -> pure $ CPContactAddress (CAPOk cld ov Nothing)
| otherwise -> pure $ CPContactAddress CAPConnectingConfirmReconnect
| connStatus == ConnPrepared -> plan $ CAPOk cld ov
| otherwise -> plan CAPConnectingConfirmReconnect
Just (RcvDirectMsgConnection _ (Just ct))
| not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnectingProhibit ct)
| contactDeleted ct -> pure $ CPContactAddress (CAPOk cld ov Nothing)
| otherwise -> pure $ CPContactAddress (CAPKnown ct)
| not (contactReady ct) && contactActive ct -> plan $ CAPConnectingProhibit ct
| contactDeleted ct -> plan $ CAPOk cld ov
| otherwise -> plan $ CAPKnown ct
-- TODO [short links] RcvGroupMsgConnection branch is deprecated? (old group link protocol?)
Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo Nothing Nothing Nothing
Just _ -> throwCmdError "found connection entity is not RcvDirectMsgConnection or RcvGroupMsgConnection"
@@ -4413,27 +4452,30 @@ processChatCommand cxt nm = \case
groupJoinRequestPlan user (CRContactUri crData) linkInfo gld ov = do
let cReqSchemas = contactCReqSchemas crData
cReqHashes = bimap contactCReqHash contactCReqHash cReqSchemas
plan p = pure $ CPGroupLink p
withFastStore' (\db -> getGroupInfoByUserContactLinkConnReq db cxt user cReqSchemas) >>= \case
Just g -> pure $ CPGroupLink (GLPOwnLink g)
Just g -> plan $ GLPOwnLink g
Nothing -> do
connEnt_ <- withFastStore' $ \db -> getContactConnEntityByConnReqHash db cxt user cReqHashes
gInfo_ <- withFastStore' $ \db -> getGroupInfoByGroupLinkHash db cxt user cReqHashes
case (gInfo_, connEnt_) of
(Nothing, Nothing) -> pure $ CPGroupLink (GLPOk linkInfo gld ov Nothing)
(Nothing, Nothing) -> plan $ GLPOk linkInfo gld ov
-- TODO [short links] RcvDirectMsgConnection branches are deprecated? (old group link protocol?)
(Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect
(Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> plan $ GLPConnectingConfirmReconnect
(Nothing, Just (RcvDirectMsgConnection _ (Just ct)))
| not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnectingProhibit gInfo_)
| otherwise -> pure $ CPGroupLink (GLPOk linkInfo gld ov Nothing)
| not (contactReady ct) && contactActive ct -> plan $ GLPConnectingProhibit gInfo_
| otherwise -> plan $ GLPOk linkInfo gld ov
(Nothing, Just _) -> throwCmdError "found connection entity is not RcvDirectMsgConnection"
(Just gInfo, _) -> groupPlan gInfo linkInfo gld ov
groupPlan :: GroupInfo -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
groupPlan gInfo@GroupInfo {membership} linkInfo gld ov
| memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo (BoolDef False) ov (ListDef []))
| memberStatus membership == GSMemRejected = plan $ GLPKnown gInfo False ov (ListDef [])
| not (memberActive membership) && not (memberRemoved membership) =
pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo)
| memberActive membership = pure $ CPGroupLink (GLPKnown gInfo (BoolDef False) ov (ListDef []))
| otherwise = pure $ CPGroupLink (GLPOk linkInfo gld ov Nothing)
plan $ GLPConnectingProhibit $ Just gInfo
| memberActive membership = plan $ GLPKnown gInfo False ov (ListDef [])
| otherwise = plan $ GLPOk linkInfo gld ov
where
plan p = pure $ CPGroupLink p
contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact)
contactCReqSchemas crData =
( CRContactUri crData {crScheme = SSSimplex},
@@ -5455,7 +5497,7 @@ chatCommandP =
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayNameP <* A.space <* char_ '@' <*> (Just <$> displayNameP) <* A.space <*> quotedMsg <*> msgTextP),
"/_contacts " *> (APIListContacts <$> A.decimal),
"/contacts" $> ListContacts,
"/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing) <*> ((" resolve=" *> onOffP) <|> pure False) <*> optional (" sig=" *> jsonP)),
"/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing) <*> ((" resolve=" *> planResolveModeP) <|> pure PRMUnknown) <*> optional (" sig=" *> jsonP)),
"/_prepare contact " *> (APIPrepareContact <$> A.decimal <* A.space <*> connLinkP <*> optional (" domain=" *> strP) <* A.space <*> jsonP),
"/_prepare group " *> (APIPrepareGroup <$> A.decimal <* A.space <*> connLinkP' <*> (" direct=" *> onOffP <|> pure True) <*> optional (" domain=" *> strP) <* A.space <*> jsonP),
"/_set contact user @" *> (APIChangePreparedContactUser <$> A.decimal <* A.space <*> A.decimal),
+9 -3
View File
@@ -1464,8 +1464,8 @@ updatePublicGroupData user gInfo
| otherwise = pure gInfo
updateGroupFromLinkData :: User -> GroupInfo -> GroupShortLinkData -> CM (GroupInfo, Bool)
updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupSummary = GroupSummary {publicMemberCount = localCount}} GroupShortLinkData {groupProfile, publicGroupData}
| profileChanged || countChanged = do
updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupDomainVerified, groupSummary = GroupSummary {publicMemberCount = localCount}} GroupShortLinkData {groupProfile, publicGroupData}
| profileChanged || countChanged || verifyChanged = do
cxt <- chatStoreCxt
withStore $ \db -> do
g <- if profileChanged then updateGroupProfile db user gInfo groupProfile else pure gInfo
@@ -1473,13 +1473,19 @@ updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupSummary = G
Just PublicGroupData {publicMemberCount} | countChanged ->
setPublicMemberCount db cxt user g publicMemberCount
_ -> pure g
pure (g', profileChanged)
-- the group's own link is authoritative for its domain claim, so a claim in the link profile is
-- verified; updateGroupProfile above clears verification on a claim change, so set it afterwards
g'' <- if verifyChanged then liftIO $ setGroupDomainVerified db user g' True else pure g'
pure (g'', profileChanged)
| otherwise = pure (gInfo, False)
where
profileChanged = p /= groupProfile
countChanged = case publicGroupData of
Just PublicGroupData {publicMemberCount} -> Just publicMemberCount /= localCount
_ -> False
groupClaim GroupProfile {publicGroup} = claimDomain <$> (publicGroup >>= publicGroupAccess >>= groupDomainClaim)
newClaim = groupClaim groupProfile
verifyChanged = isJust newClaim && (groupDomainVerified /= Just True || groupClaim p /= newClaim)
updateContactFromLinkData :: User -> Contact -> Profile -> CM Contact
updateContactFromLinkData user ct@Contact {profile = profile@LocalProfile {contactDomain = prevClaim, contactDomainVerified}} linkProfile@Profile {contactDomain = newClaim}
+9 -4
View File
@@ -238,7 +238,7 @@ import Simplex.Chat.Types.MemberRelations (IntroductionDirection (..), MemberRel
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (ConfirmationId, ConnId, CreatedConnLink (..), InvitationId, OwnerAuth (..), SimplexNameInfo (..), UserId)
import Simplex.Messaging.Agent.Protocol (ConfirmationId, ConnId, CreatedConnLink (..), InvitationId, OwnerAuth (..), SimplexNameInfo (..), SimplexNameType (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import qualified Simplex.FileTransfer.Description as FD
import Simplex.Messaging.Encoding (smpDecode, smpEncode)
@@ -1083,9 +1083,14 @@ getGroupToConnect :: DB.Connection -> StoreCxt -> User -> ContactNameOrLink -> E
getGroupToConnect db cxt user@User {userId} = \case
CTLink sl -> first (`CCLink` Just sl) <$$> getGroupViaShortLinkToConnect db cxt user sl
CTName ni ->
liftIO (maybeFirstRow id $ DB.query db byNameQuery (userId, nameDomain ni)) >>= \case
Just (gId :: Int64, Just cReq, Just (sLnk :: ShortLinkContact)) -> Just . (CCLink cReq (Just sLnk),) <$> getGroupInfo db cxt user gId
_ -> pure Nothing
-- @name is a business (presents as a contact); #name is a channel. The same domain can have both,
-- so the group type must match the requested name type.
let businessCond = case nameType ni of
NTContact -> " AND g.business_chat IS NOT NULL"
NTPublicGroup -> " AND g.business_chat IS NULL"
in liftIO (maybeFirstRow id $ DB.query db (byNameQuery <> businessCond) (userId, nameDomain ni)) >>= \case
Just (gId :: Int64, Just cReq, Just (sLnk :: ShortLinkContact)) -> Just . (CCLink cReq (Just sLnk),) <$> getGroupInfo db cxt user gId
_ -> pure Nothing
where
byNameQuery =
[sql|
+4 -1
View File
@@ -60,7 +60,7 @@ import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.FileTransfer.Description (FileDigest)
import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
import Simplex.Messaging.Agent.Protocol (ACorrId, ACreatedConnLink, AConnectionLink (..), AEventTag (..), AEvtTag (..), ConnId, ConnShortLink (..), ConnectionLink (..), ConnectionMode (..), ConnectionModeI, ConnectionRequestUri, ContactConnType (..), CreatedConnLink (..), InvitationId, SAEntity (..), SConnectionMode (..), SimplexNameInfo, UserId)
import Simplex.Messaging.Agent.Protocol (ACorrId, ACreatedConnLink, AConnectionLink (..), AEventTag (..), AEvtTag (..), ConnId, ConnShortLink (..), ConnectionLink (..), ConnectionMode (..), ConnectionModeI, ConnectionRequestUri, ContactConnType (..), CreatedConnLink (..), InvitationId, SAEntity (..), SConnectionMode (..), SimplexDomain, SimplexNameInfo (..), UserId)
import Simplex.Messaging.Agent.Store.DB (Binary (..), blobFieldDecoder, fromTextField_)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
@@ -1789,6 +1789,7 @@ type ConnReqContact = ConnectionRequestUri 'CMContact
data ConnectTarget (m :: ConnectionMode) where
CTFullContact :: ConnectionRequestUri 'CMContact -> ConnectTarget 'CMContact
CTShortContact :: ContactNameOrLink -> ConnectTarget 'CMContact
CTDomain :: SimplexDomain -> ConnectTarget 'CMContact
CTInv :: ConnectionLink 'CMInvitation -> ConnectTarget 'CMInvitation
data ContactNameOrLink = CTName SimplexNameInfo | CTLink (ConnShortLink 'CMContact)
@@ -1813,10 +1814,12 @@ instance StrEncoding AConnectTarget where
CTFullContact cr -> strEncode cr
CTShortContact (CTName n) -> strEncode n
CTShortContact (CTLink sl) -> strEncode sl
CTDomain d -> strEncode d
CTInv l -> strEncode l
strP =
(ACTarget SCMContact . CTShortContact . CTName <$> (lookAhead nameStart *> strP))
<|> (aConnectTarget <$> strP)
<|> (ACTarget SCMContact . CTDomain <$> strP)
where
nameStart = "@" <|> "#" <|> "simplex:/name"
+10 -3
View File
@@ -204,7 +204,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
CRInvitation u ccLink _ -> ttyUser u $ viewConnReqInvitation ccLink
CRConnectionIncognitoUpdated u c customUserProfile -> ttyUser u $ viewConnectionIncognitoUpdated c customUserProfile testView
CRConnectionUserChanged u c c' nu -> ttyUser u $ viewConnectionUserChanged u c nu c'
CRConnectionPlan u connLink connectionPlan -> ttyUser u $ viewConnectionPlan cfg connLink connectionPlan
CRConnectionPlan u connLink _ otherSimplexName connectionPlan -> ttyUser u $ viewConnectionPlan cfg connLink connectionPlan <> otherSimplexNameNote otherSimplexName
CRNewPreparedChat u (AChat _ (Chat cInfo _ _)) -> ttyUser u $ case cInfo of
DirectChat ct -> [ttyContact' ct <> ": contact is prepared"]
GroupChat g _ -> [ttyGroup' g <> ": group is prepared"]
@@ -2144,6 +2144,12 @@ viewGroupUserChanged
where
userChangedStr = "group " <> ttyGroup' g <> " changed from user " <> plain un <> " to user " <> plain un'
otherSimplexNameNote :: Maybe SimplexNameInfo -> [StyledString]
otherSimplexNameNote = \case
Just ni@(SimplexNameInfo NTPublicGroup _) -> [plain $ "You can also join channel " <> shortNameInfoStr ni]
Just ni@(SimplexNameInfo NTContact _) -> [plain $ "You can also connect to " <> shortNameInfoStr ni <> " in direct chat"]
Nothing -> []
viewConnectionPlan :: ChatConfig -> ACreatedConnLink -> ConnectionPlan -> [StyledString]
viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
CPInvitationLink ilp -> case ilp of
@@ -2165,7 +2171,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
| business -> ("business address: " <>)
_ -> ("invitation link: " <>)
CPContactAddress cap -> case cap of
CAPOk contactSLinkData ov _ -> [addrOrBiz contactSLinkData "ok to connect"] <> viewSigVerification ov <> [viewJSON contactSLinkData | testView]
CAPOk contactSLinkData ov -> [addrOrBiz contactSLinkData "ok to connect"] <> viewSigVerification ov <> [viewJSON contactSLinkData | testView]
CAPOwnLink -> [ctAddr "own address"]
CAPConnectingConfirmReconnect -> [ctAddr "connecting, allowed to reconnect"]
CAPConnectingProhibit ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
@@ -2183,7 +2189,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
| business -> ("business address: " <>)
_ -> ("contact address: " <>)
CPGroupLink glp -> case glp of
GLPOk groupSLinkInfo_ groupSLinkData ov _ ->
GLPOk groupSLinkInfo_ groupSLinkData ov ->
let direct = maybe True (\(GroupShortLinkInfo {direct = d}) -> d) groupSLinkInfo_
in [grpLink $ if direct then "ok to connect directly" else "ok to connect via relays"]
<> viewSigVerification ov
@@ -2687,6 +2693,7 @@ viewChatError isCmd logLevel testView = \case
SDENoValidLink -> "has no valid connection link"
SDEUnknownDomain -> "is not included in the connection link's profile"
in [plain $ "SimpleX name " <> strEncode domain <> " " <> reason]
CENotResolvedLocally -> ["no matching chat found, name resolution is disabled"]
CEUnsupportedConnReq -> [ "", "Connection link is not supported by the your app version, please ugrade it.", plain updateStr]
CEInvalidChatMessage Connection {connId} msgMeta_ msg e ->
[ plain $