diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 3591bd0399..1bc3eef0f8 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -979,7 +979,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName let GroupShortLinkData {groupProfile = GroupProfile {displayName}} = groupSLinkData ownerContact = GroupOwnerContact {contactId = contactId' ct, memberId = mId} sendMessage cc ct $ "Joining the " <> gt <> " " <> displayName <> "…" - sendChatCmd cc (APIPrepareGroup userId ccLink False groupSLinkData) >>= \case + sendChatCmd cc (APIPrepareGroup userId ccLink False groupSLinkData Nothing) >>= \case Right (CRNewPreparedChat _ (AChat SCTGroup (Chat (GroupChat gInfo _) _ _))) -> do let gId = groupId' gInfo addGroupReg notifyAdminUsers st cc ct gInfo GRSProposed $ \_ -> pure () diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index c3b839b08b..1ef866b11a 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -529,8 +529,8 @@ data ChatCommand | 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 - | APIPrepareContact UserId ACreatedConnLink ContactShortLinkData - | APIPrepareGroup UserId CreatedLinkContact DirectLink GroupShortLinkData + | APIPrepareContact UserId ACreatedConnLink ContactShortLinkData (Maybe SimplexNameInfo) + | APIPrepareGroup UserId CreatedLinkContact DirectLink GroupShortLinkData (Maybe SimplexNameInfo) | APIChangePreparedContactUser ContactId UserId | APIChangePreparedGroupUser GroupId UserId | APIConnectPreparedContact {contactId :: ContactId, incognito :: IncognitoEnabled, msgContent_ :: Maybe MsgContent} @@ -1095,7 +1095,7 @@ data InvitationLinkPlan deriving (Show) data ContactAddressPlan - = CAPOk {contactSLinkData_ :: Maybe ContactShortLinkData, ownerVerification :: Maybe OwnerVerification} + = CAPOk {contactSLinkData_ :: Maybe ContactShortLinkData, ownerVerification :: Maybe OwnerVerification, verifiedName :: Maybe SimplexNameInfo} | CAPOwnLink | CAPConnectingConfirmReconnect | CAPConnectingProhibit {contact :: Contact} @@ -1104,7 +1104,7 @@ data ContactAddressPlan deriving (Show) data GroupLinkPlan - = GLPOk {groupSLinkInfo_ :: Maybe GroupShortLinkInfo, groupSLinkData_ :: Maybe GroupShortLinkData, ownerVerification :: Maybe OwnerVerification} + = GLPOk {groupSLinkInfo_ :: Maybe GroupShortLinkInfo, groupSLinkData_ :: Maybe GroupShortLinkData, ownerVerification :: Maybe OwnerVerification, verifiedName :: Maybe SimplexNameInfo} | GLPOwnLink {groupInfo :: GroupInfo} | GLPConnectingConfirmReconnect | GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index f37e7bf279..d0f435f6a0 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2061,7 +2061,7 @@ processChatCommand cxt nm = \case APIConnectPlan userId (Just ct) resolveKnown linkOwnerSig_ -> withUserId userId $ \user -> uncurry (CRConnectionPlan user) <$> connectPlan user ct resolveKnown linkOwnerSig_ APIConnectPlan _ Nothing _ _ -> throwChatError CEInvalidConnReq - APIPrepareContact userId accLink contactSLinkData -> withUserId userId $ \user -> do + APIPrepareContact userId accLink contactSLinkData verifiedName -> withUserId userId $ \user -> do let ContactShortLinkData {profile, message, business} = contactSLinkData welcomeSharedMsgId <- forM message $ \_ -> getSharedMsgId case accLink of @@ -2084,7 +2084,7 @@ processChatCommand cxt nm = \case _ -> Chat cInfo [] emptyChatStats pure $ CRNewPreparedChat user $ AChat SCTGroup chat ACCL _ (CCLink cReq _) -> do - ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId Nothing + ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId (True <$ verifiedName) void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing Nothing (Just epochStart) let cd = CDDirectRcv ct createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing Nothing @@ -2096,10 +2096,10 @@ processChatCommand cxt nm = \case Just (AChatItem SCTDirect dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci} _ -> Chat cInfo [] emptyChatStats pure $ CRNewPreparedChat user $ AChat SCTDirect chat - APIPrepareGroup userId ccLink direct groupSLinkData -> withUserId userId $ \user -> do + APIPrepareGroup userId ccLink direct groupSLinkData verifiedName -> withUserId userId $ \user -> do let GroupShortLinkData {groupProfile = GroupProfile {description}} = groupSLinkData welcomeSharedMsgId <- forM description $ \_ -> getSharedMsgId - (gInfo, hostMember_) <- preparedGroupFromLink user ccLink direct groupSLinkData welcomeSharedMsgId Nothing + (gInfo, hostMember_) <- preparedGroupFromLink user ccLink direct groupSLinkData welcomeSharedMsgId (True <$ verifiedName) void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) let cd = maybe (CDChannelRcv gInfo Nothing) (CDGroupRcv gInfo Nothing) hostMember_ cInfo = GroupChat gInfo Nothing @@ -2320,7 +2320,7 @@ 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)) + plan <- contactRequestPlan user adminContactReq Nothing Nothing `catchAllErrors` const (pure $ CPContactAddress (CAPOk Nothing Nothing Nothing)) connectWithPlan user incognito (ACCL SCMContact (CCLink adminContactReq Nothing)) plan DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId Nothing) cdm ClearContact cName -> withContactName cName $ \chatId -> APIClearChat $ ChatRef CTDirect chatId Nothing @@ -4213,10 +4213,9 @@ processChatCommand cxt nm = \case ov = verifyLinkOwner rootKey owners l' sig_ plan <- contactRequestPlan user cReq contactSLinkData_ ov case (nl, plan) of - (CTName ni, CPContactAddress (CAPOk (Just ContactShortLinkData {profile = p@Profile {simplexName}}) _)) -> do - domainVerified <- verifyNameClaim ni (claimName <$> simplexName) - ct' <- withStore $ \db -> createPreparedContact db cxt user p (con l' cReq) Nothing domainVerified - pure (con l' cReq, CPContactAddress (CAPKnown ct')) + (CTName ni, CPContactAddress cap@(CAPOk (Just ContactShortLinkData {profile = Profile {simplexName}}) _ _)) -> do + _ <- verifyNameClaim ni (claimName <$> simplexName) + pure (con l' cReq, CPContactAddress cap {verifiedName = Just ni}) _ -> pure (con l' cReq, plan) where knownLinkPlans = withFastStore $ \db -> @@ -4266,12 +4265,11 @@ processChatCommand cxt nm = \case let ov = verifyLinkOwner rootKey owners l' sig_ plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov case (nl, plan) of - (CTName ni, CPGroupLink (GLPOk (Just _) (Just gld) _)) -> do + (CTName ni, CPGroupLink glp@(GLPOk (Just _) (Just gld) _ _)) -> do let GroupShortLinkData {groupProfile = GroupProfile {publicGroup = pg}} = gld gName = claimName <$> (pg >>= publicGroupAccess >>= publicGroupClaim) - domainVerified <- verifyNameClaim ni gName - (g, _) <- preparedGroupFromLink user (CCLink cReq (Just l')) direct gld Nothing domainVerified - pure (con l' cReq, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef []))) + _ <- verifyNameClaim ni gName + pure (con l' cReq, CPGroupLink glp {verifiedName = Just ni}) _ -> pure (con l' cReq, plan) where unsupportedGroupType = \case @@ -4307,13 +4305,13 @@ processChatCommand cxt nm = \case case plan of CPContactAddress (CAPContactViaAddress Contact {contactId}) -> processChatCommand cxt nm $ APIConnectContactViaAddress userId incognito contactId - CPGroupLink (GLPOk (Just GroupShortLinkInfo {direct = False}) (Just gld) _) - | ACCL SCMContact ccl <- ccLink -> joinChannelViaRelays ccl gld + CPGroupLink (GLPOk (Just GroupShortLinkInfo {direct = False}) (Just gld) _ vName) + | ACCL SCMContact ccl <- ccLink -> joinChannelViaRelays ccl gld vName _ -> processChatCommand cxt nm $ APIConnect userId incognito $ Just ccLink | otherwise = pure $ CRConnectionPlan user ccLink plan where - joinChannelViaRelays :: CreatedLinkContact -> GroupShortLinkData -> CM ChatResponse - joinChannelViaRelays ccl gld = do + joinChannelViaRelays :: CreatedLinkContact -> GroupShortLinkData -> Maybe SimplexNameInfo -> CM ChatResponse + joinChannelViaRelays ccl gld vName = do GroupInfo {groupId} <- prepareChannelGroup processChatCommand cxt nm APIConnectPreparedGroup {groupId, incognito, ownerContact = Nothing, msgContent_ = Nothing} `catchAllErrors` \e -> do @@ -4321,7 +4319,7 @@ processChatCommand cxt nm = \case throwError e where prepareChannelGroup = - processChatCommand cxt nm (APIPrepareGroup userId ccl False gld) >>= \case + processChatCommand cxt nm (APIPrepareGroup userId ccl False gld vName) >>= \case CRNewPreparedChat _ (AChat SCTGroup (Chat (GroupChat gInfo _) _ _)) -> pure gInfo _ -> throwChatError $ CEException "joinChannelViaRelays: unexpected response from APIPrepareGroup" deletePreparedChannel groupId = do @@ -4367,13 +4365,13 @@ processChatCommand cxt nm = \case Nothing -> withFastStore' (\db -> getContactWithoutConnViaAddress db cxt user cReqSchemas) >>= \case Just ct | not (contactDeleted ct) -> pure $ CPContactAddress (CAPContactViaAddress ct) - _ -> pure $ CPContactAddress (CAPOk cld ov) + _ -> pure $ CPContactAddress (CAPOk cld ov Nothing) Just (RcvDirectMsgConnection Connection {connStatus} Nothing) - | connStatus == ConnPrepared -> pure $ CPContactAddress (CAPOk cld ov) + | connStatus == ConnPrepared -> pure $ CPContactAddress (CAPOk cld ov Nothing) | otherwise -> pure $ CPContactAddress CAPConnectingConfirmReconnect Just (RcvDirectMsgConnection _ (Just ct)) | not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnectingProhibit ct) - | contactDeleted ct -> pure $ CPContactAddress (CAPOk cld ov) + | contactDeleted ct -> pure $ CPContactAddress (CAPOk cld ov Nothing) | otherwise -> pure $ CPContactAddress (CAPKnown ct) -- TODO [short links] RcvGroupMsgConnection branch is deprecated? (old group link protocol?) Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo Nothing Nothing Nothing @@ -4388,12 +4386,12 @@ processChatCommand cxt nm = \case 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) -> pure $ CPGroupLink (GLPOk linkInfo gld ov Nothing) -- TODO [short links] RcvDirectMsgConnection branches are deprecated? (old group link protocol?) (Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect (Nothing, Just (RcvDirectMsgConnection _ (Just ct))) | not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnectingProhibit gInfo_) - | otherwise -> pure $ CPGroupLink (GLPOk linkInfo gld ov) + | otherwise -> pure $ CPGroupLink (GLPOk linkInfo gld ov Nothing) (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 @@ -4402,7 +4400,7 @@ processChatCommand cxt nm = \case | 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) + | otherwise = pure $ CPGroupLink (GLPOk linkInfo gld ov Nothing) contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact) contactCReqSchemas crData = ( CRContactUri crData {crScheme = SSSimplex}, @@ -5455,8 +5453,8 @@ chatCommandP = "/_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)), - "/_prepare contact " *> (APIPrepareContact <$> A.decimal <* A.space <*> connLinkP <* A.space <*> jsonP), - "/_prepare group " *> (APIPrepareGroup <$> A.decimal <* A.space <*> connLinkP' <*> (" direct=" *> onOffP <|> pure True) <* A.space <*> jsonP), + "/_prepare contact " *> (APIPrepareContact <$> A.decimal <* A.space <*> connLinkP <* A.space <*> jsonP <*> optional (A.space *> strP)), + "/_prepare group " *> (APIPrepareGroup <$> A.decimal <* A.space <*> connLinkP' <*> (" direct=" *> onOffP <|> pure True) <* A.space <*> jsonP <*> optional (A.space *> strP)), "/_set contact user @" *> (APIChangePreparedContactUser <$> A.decimal <* A.space <*> A.decimal), "/_set group user #" *> (APIChangePreparedGroupUser <$> A.decimal <* A.space <*> A.decimal), "/_connect contact @" *> (APIConnectPreparedContact <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)), diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index a54f0e6650..6d599ce128 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -2166,7 +2166,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)] @@ -2184,7 +2184,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 diff --git a/tests/ChatTests/Names.hs b/tests/ChatTests/Names.hs index 8a299dd0f8..d9afa8f7ab 100644 --- a/tests/ChatTests/Names.hs +++ b/tests/ChatTests/Names.hs @@ -31,29 +31,13 @@ testConnectByName ps = withSmpServerAndNames $ \reg -> alice ##> "/_set_name 1 @alice.simplex" alice <## "new contact address set" bob ##> "/c @alice.simplex" - bob <## "contact address: known prepared contact alice" - bob <## "simplex name: @alice.simplex (verified)" - bob ##> "/_connect contact @2 text hello" - bob - <### [ "alice: connection started", - WithTime "@alice hello" - ] - alice - <### [ "bob (Bob) wants to connect to you!", - WithTime "bob> hello" - ] - alice <## "to accept: /ac bob" - alice <## "to reject: /rc bob (the sender will NOT be notified)" + alice <#? bob alice ##> "/ac bob" alice <## "bob (Bob): accepting contact request, you can send messages to contact" concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") alice <##> bob - -- the name is bound to the link profile (verified on connect) but the contact address - -- carries no proof, so on-demand proof verification is inconclusive - bob ##> "/_verify name @2" - bob <## "simplex name @alice.simplex not verified: no name proof to verify" testConnectByNameNotClaimed :: HasCallStack => TestParams -> IO () testConnectByNameNotClaimed ps = withSmpServerAndNames $ \reg ->