diff --git a/bots/src/API/Docs/Commands.hs b/bots/src/API/Docs/Commands.hs index 618546f438..64fd12f32f 100644 --- a/bots/src/API/Docs/Commands.hs +++ b/bots/src/API/Docs/Commands.hs @@ -151,8 +151,7 @@ chatCommandsDocsData = ("APIDeleteChat", [], "Delete chat.", ["CRContactDeleted", "CRContactConnectionDeleted", "CRGroupDeletedUser", "CRChatCmdError"], [], Just UNBackground, "/_delete " <> Param "chatRef" <> " " <> Param "chatDeleteMode"), ("APISetGroupCustomData", [], "Set group custom data.", ["CRCmdOk", "CRChatCmdError"], [], Nothing, "/_set custom #" <> Param "groupId" <> Optional "" (" " <> Json "$0") "customData"), ("APISetContactCustomData", [], "Set contact custom data.", ["CRCmdOk", "CRChatCmdError"], [], Nothing, "/_set custom @" <> Param "contactId" <> Optional "" (" " <> Json "$0") "customData"), - ("APISetUserAutoAcceptMemberContacts", [], "Set auto-accept member contacts.", ["CRCmdOk", "CRChatCmdError"], [], Nothing, "/_set accept member contacts " <> Param "userId" <> " " <> OnOff "onOff"), - ("APIVerifySimplexName", [], "Verify a contact's or group's claimed SimpleX name by RSLV-resolving the claim and comparing the resolved link to the peer's stored connection link. Returns `CRSimplexNameVerified` with a boolean `verified` (a match also writes the verification timestamp); resolver / agent failures are reported as `CRChatCmdError`.", ["CRSimplexNameVerified", "CRChatCmdError"], [], Just UNInteractive, "/_verify simplex name " <> Param "chatRef") + ("APISetUserAutoAcceptMemberContacts", [], "Set auto-accept member contacts.", ["CRCmdOk", "CRChatCmdError"], [], Nothing, "/_set accept member contacts " <> Param "userId" <> " " <> OnOff "onOff") -- ("APIChatItemsRead", [], "Mark items as read.", ["CRItemsReadForChat"], [], Nothing, ""), -- ("APIChatRead", [], "Mark chat as read.", ["CRCmdOk"], [], Nothing, ""), -- ("APIChatUnread", [], "Mark chat as unread.", ["CRCmdOk"], [], Nothing, ""), @@ -434,7 +433,9 @@ undocumentedCommands = "APIUserRead", "APIValidateServers", "APIVerifyContact", + "APIVerifyContactName", "APIVerifyGroupMember", + "APIVerifyPublicGroupName", "APIVerifyToken", "CheckChatRunning", "ConfirmRemoteCtrl", diff --git a/bots/src/API/Docs/Responses.hs b/bots/src/API/Docs/Responses.hs index ed5403d8e5..b7de415f13 100644 --- a/bots/src/API/Docs/Responses.hs +++ b/bots/src/API/Docs/Responses.hs @@ -89,7 +89,6 @@ chatResponsesDocsData = ("CRSentConfirmation", "Confirmation sent to one-time invitation"), ("CRSentGroupInvitation", "Group invitation sent"), ("CRSentInvitation", "Invitation sent to contact address"), - ("CRSimplexNameVerified", "Result of SimpleX name verification (`verified`: whether the RSLV-resolved link matches the peer's stored link)"), ("CRSndFileCancelled", "Cancelled sending file"), ("CRUserAcceptedGroupSent", "User accepted group invitation"), ("CRUserContactLink", "User contact address"), @@ -149,6 +148,7 @@ undocumentedResponses = "CRContactAliasUpdated", "CRContactCode", "CRContactInfo", + "CRContactNameVerified", "CRContactRatchetSyncStarted", "CRContactSwitchAborted", "CRContactSwitchStarted", @@ -168,6 +168,7 @@ undocumentedResponses = "CRGroupMemberRatchetSyncStarted", "CRGroupMemberSwitchAborted", "CRGroupMemberSwitchStarted", + "CRGroupNameVerified", "CRGroupProfile", "CRGroupUserChanged", "CRItemsReadForChat", diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 13b0803f94..3ad165f3cb 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -537,12 +537,12 @@ data ChatCommand | APIConnectPreparedGroup {groupId :: GroupId, incognito :: IncognitoEnabled, ownerContact :: Maybe GroupOwnerContact, msgContent_ :: Maybe MsgContent} | APIConnect {userId :: UserId, incognito :: IncognitoEnabled, preparedLink_ :: Maybe ACreatedConnLink} -- Maybe is used to report link parsing failure as special error | Connect {incognito :: IncognitoEnabled, connTarget_ :: Maybe ConnectTarget} - | -- Resolves the name claim on the chat row (contact or group) via RSLV and - -- compares the resolved link to the peer's stored connection link. Returns - -- CRSimplexNameVerified with the boolean result (persisted as the 3-state - -- contact_domain_verification / group_domain_verification); resolver / agent - -- failures surface as ChatErrorAgent. - APIVerifySimplexName {chatRef :: ChatRef} + | -- Verify a contact's / channel's claimed name (§4.6): resolve it, check the stored proof is signed + -- by the resolved name owner and bound to the connected link, persist the 3-state status, and + -- return the updated entity plus a Nothing/Just-reason result. Resolver/agent failures surface as + -- ChatErrorAgent (retryable). + APIVerifyContactName {contactId :: ContactId} + | APIVerifyPublicGroupName {groupId :: GroupId} | APIConnectContactViaAddress UserId IncognitoEnabled ContactId | ConnectSimplex IncognitoEnabled -- UserId (not used in UI) | DeleteContact ContactName ChatDeleteMode @@ -781,7 +781,8 @@ data ChatResponse | CRContactCode {user :: User, contact :: Contact, connectionCode :: Text} | CRGroupMemberCode {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text} | CRConnectionVerified {user :: User, verified :: Bool, expectedCode :: Text} - | CRSimplexNameVerified {user :: User, chatRef :: ChatRef, simplexName :: SimplexNameInfo, verified :: Bool} + | CRContactNameVerified {user :: User, contact :: Contact, verificationResult :: Maybe Text} + | CRGroupNameVerified {user :: User, groupInfo :: GroupInfo, verificationResult :: Maybe Text} | CRTagsUpdated {user :: User, userTags :: [ChatTag], chatTags :: [ChatTagId]} | CRNewChatItems {user :: User, chatItems :: [AChatItem]} | CRChatItemUpdated {user :: User, chatItem :: AChatItem} @@ -1429,7 +1430,6 @@ data ChatErrorType | CEChatStoreChanged | CEInvalidConnReq | CESimplexNameNotFound {simplexName :: SimplexNameInfo} - | CESimplexNameUnprepared {simplexName :: SimplexNameInfo} | CEUnsupportedConnReq | CEInvalidChatMessage {connection :: Connection, msgMeta :: Maybe MsgMetaJSON, messageData :: Text, message :: String} | CEConnReqMessageProhibited diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 689ff93bce..be17a7ea41 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1492,25 +1492,26 @@ processChatCommand cxt nm = \case updateCallItemStatus user ct call receivedStatus Nothing $> Just call APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile) APISetUserName userId name_ -> withUserId userId $ \user@User {profile = oldLP@LocalProfile {contactLink = oldContactLink}} -> do - -- §4.9 steps 1-2: getUserAddress fails if there is no address; if the address is long-link only, - -- create the short link (names resolve to short links), reusing the APIAddMyAddressShortLink path - ucl0@UserContactLink {shortLinkDataSet} <- withFastStore $ \db -> getUserAddress db user - UserContactLink {connLinkContact = CCLink ourFull_ ourShort_} <- - if shortLinkDataSet then pure ucl0 else setMyAddressData user ucl0 - let ourLink = maybe (CLFull ourFull_) CLShort ourShort_ - -- §4.9: names are pre-registered out of band; verify the name resolves to THIS address before setting it - forM_ name_ $ \name -> do - let SimplexNameInfo {nameDomain = domain} = name - a <- asks smpAgent - NameRecord {nrSimplexContact} <- liftIO (runExceptT $ resolveSimplexName a nm (aUserId user) domain) >>= either (throwError . chatErrorAgent) pure - -- the registry resolves a name to short links; require it to point to our address's short link - let resolvesHere resolved = case strDecode (encodeUtf8 resolved) :: Either String AConnectionLink of - Right (ACL SCMContact (CLShort sl)) -> maybe False (sameShortLinkContact sl) ourShort_ - _ -> False - unless (any resolvesHere nrSimplexContact) $ throwCmdError "name is not registered to your address" - -- §4.9 step 3: a name in the profile must carry its address, so write the address short link into contactLink - -- alongside the name. updateProfile_ then re-publishes the address (signing the proof) and broadcasts to contacts. - let p' = (fromLocalProfile oldLP :: Profile) {contactDomain = StrJSON <$> name_, contactLink = maybe oldContactLink (const (Just ourLink)) name_} + -- When SETTING a name (§4.9 steps 1-4): require an address (getUserAddress fails if none; a long-link-only + -- address gets a short link created, reusing the APIAddMyAddressShortLink path), verify the name resolves to + -- it, and write the address short link into contactLink. When CLEARING (Nothing): just drop the name — no + -- address fetch or short-link creation. + contactLink' <- case name_ of + Nothing -> pure oldContactLink + Just name -> do + ucl0@UserContactLink {shortLinkDataSet} <- withFastStore $ \db -> getUserAddress db user + UserContactLink {connLinkContact = CCLink ourFull_ ourShort_} <- + if shortLinkDataSet then pure ucl0 else setMyAddressData user ucl0 + let SimplexNameInfo {nameDomain = domain} = name + a <- asks smpAgent + NameRecord {nrSimplexContact} <- liftIO (runExceptT $ resolveSimplexName a nm (aUserId user) domain) >>= either (throwError . chatErrorAgent) pure + -- the registry resolves a name to short links; require it to point to our address's short link + let resolvesHere resolved = case strDecode (encodeUtf8 resolved) :: Either String AConnectionLink of + Right (ACL SCMContact (CLShort sl)) -> maybe False (sameShortLinkContact sl) ourShort_ + _ -> False + unless (any resolvesHere nrSimplexContact) $ throwCmdError "name is not registered to your address" + pure $ Just $ maybe (CLFull ourFull_) CLShort ourShort_ + let p' = (fromLocalProfile oldLP :: Profile) {contactDomain = StrJSON <$> name_, contactLink = contactLink'} updateProfile_ user p' True $ withFastStore $ \db -> do user' <- updateUserProfile db user p' liftIO $ setUserSimplexName db user' name_ @@ -2301,7 +2302,8 @@ processChatCommand cxt nm = \case _ -> throwError e connectWithPlan user incognito ccLink plan Connect _ Nothing -> throwChatError CEInvalidConnReq - APIVerifySimplexName chatRef -> withUser $ \user -> apiVerifySimplexName user nm chatRef + APIVerifyContactName contactId -> withUser $ \user -> apiVerifyContactName user nm contactId + APIVerifyPublicGroupName groupId -> withUser $ \user -> apiVerifyPublicGroupName user nm groupId APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do ct@Contact {profile = LocalProfile {contactLink}} <- withFastStore $ \db -> getContact db cxt user contactId ccLink <- case contactLink of @@ -4852,12 +4854,6 @@ firstNameLink nameType simplexChannel simplexContact ni = NTPublicGroup -> simplexChannel NTContact -> simplexContact --- | Resolves the chat row's name claim via RSLV (the agent picks a names --- server) and compares the resolved per-type link to the peer's stored --- connection link. Persists the 3-state verification result. Returns --- CRSimplexNameVerified with the boolean result (mirrors CRConnectionVerified); --- resolver / agent failures propagate as the usual ChatErrorAgent. --- Throws a command error when the row has no claim to verify. -- sign the channel's name claim with the owner's member key, bound to the channel link -- (linkOwnerId = Just memberId — channels have delegated owners). No-op without a name or keys. signChannelNameProof :: GroupInfo -> PublicGroupProfile -> PublicGroupAccess -> PublicGroupAccess @@ -4867,69 +4863,101 @@ signChannelNameProof GroupInfo {groupKeys, membership = GroupMember {memberId = access {groupDomainProof = Just $ signNameProof memberPrivKey (Just mid) name (PHSimplexLink (ACSL SCMContact groupLink))} _ -> access -apiVerifySimplexName :: User -> NetworkRequestMode -> ChatRef -> CM ChatResponse -apiVerifySimplexName user nm chatRef = do +-- | The outcome of verifying a name claim: verified, a determinate failure (persist Just False), or +-- inconclusive (can't verify — leave the stored status untouched). The Text is a human-readable reason +-- for the UI; name-verification failures are rare, so the reason is a string rather than a typed enum +-- the clients would have to switch on. +data NameVerifyOutcome = NVOVerified | NVOFailed Text | NVOInconclusive Text + +-- §4.6: a name verifies when the proof's presHeader is the link the peer was actually connected through +-- (anti-replay) AND the proof is signed by the key the name resolves to (the address root key, or the +-- channel owner's key selected by linkOwnerId). The key comes from *resolving the name* (the address), +-- not the connected link — for a 1-time invite they differ. A network/agent error propagates as +-- ChatErrorAgent so a UI-triggered verify can retry, rather than recording a false verdict. +verifyName :: User -> NetworkRequestMode -> SimplexNameInfo -> Maybe AConnShortLink -> Maybe NameClaimProof -> CM NameVerifyOutcome +verifyName user nm claim connLink_ proof_ = case (proof_, connLink_) of + (Nothing, _) -> pure $ NVOInconclusive "no name proof to verify" + (_, Nothing) -> pure $ NVOInconclusive "no connection link to check the name proof against" + (Just proof, Just connLink) + | not (proofBoundTo proof connLink) -> + pure $ NVOFailed "the name proof is bound to a different link than the one used to connect" + | otherwise -> do + let SimplexNameInfo {nameType, nameDomain} = claim + a <- asks smpAgent + NameRecord {nrSimplexContact, nrSimplexChannel} <- + liftIO (runExceptT $ resolveSimplexName a nm (aUserId user) nameDomain) >>= either (throwError . chatErrorAgent) pure + let resolvedLinks = case nameType of + NTContact -> nrSimplexContact + NTPublicGroup -> nrSimplexChannel + if null resolvedLinks + then pure $ NVOFailed "the name is not registered (it does not resolve to any address)" + else do + ok <- or <$> mapM (verifyProofKey nm user claim proof) resolvedLinks + pure $ + if ok + then NVOVerified + else NVOFailed "the name resolves to a different address — its owner did not sign this name proof" + +-- the proof must be bound (anti-replay) to the link the peer was connected through +proofBoundTo :: NameClaimProof -> AConnShortLink -> Bool +proofBoundTo NameClaimProof {presHeader} connLink = + maybe False (`sameConnShortLink` connLink) (proofPresHeaderLink presHeader) + +-- verify the proof signature against the resolved name's owner key; +-- getShortLinkConnReq's network/agent error propagates (UI can retry), not recorded as a verdict +verifyProofKey :: NetworkRequestMode -> User -> SimplexNameInfo -> NameClaimProof -> Text -> CM Bool +verifyProofKey nm user claim proof@NameClaimProof {linkOwnerId} resolvedText = + case strDecode (encodeUtf8 resolvedText) :: Either String AConnectionLink of + Right (ACL SCMContact (CLShort sLnk)) -> do + (FixedLinkData {rootKey}, ContactLinkData _ UserContactData {owners}) <- getShortLinkConnReq nm user sLnk + let key_ = case linkOwnerId of + Nothing -> Just rootKey + Just (StrJSON oid) -> ownerKey <$> find (\OwnerAuth {ownerId} -> ownerId == oid) owners + pure $ maybe False (\key -> verifyNameProofSig key claim proof) key_ + _ -> pure False + +-- the boolean to persist (Nothing = inconclusive — leave the stored status untouched) +nameVerifyVerdict :: NameVerifyOutcome -> Maybe Bool +nameVerifyVerdict = \case + NVOVerified -> Just True + NVOFailed _ -> Just False + NVOInconclusive _ -> Nothing + +-- the human-readable failure reason for the UI (Nothing = verified) +nameVerifyReason :: NameVerifyOutcome -> Maybe Text +nameVerifyReason = \case + NVOVerified -> Nothing + NVOFailed r -> Just r + NVOInconclusive r -> Just r + +-- | Verify a contact's claimed name (§4.6): persist the 3-state status and return the updated contact +-- with a Nothing/Just-reason result. Network/resolver failures surface as ChatErrorAgent (retryable). +apiVerifyContactName :: User -> NetworkRequestMode -> ContactId -> CM ChatResponse +apiVerifyContactName user nm contactId = do cxt <- chatStoreCxt - (claim, connLink_, proof_, persistVerified) <- loadClaimAndLink cxt - let SimplexNameInfo {nameType = nameType', nameDomain = domain} = claim - User {userId} = user - a <- asks smpAgent - NameRecord {nrSimplexContact, nrSimplexChannel} <- - liftIO (runExceptT $ resolveSimplexName a nm userId domain) >>= either (throwError . chatErrorAgent) pure - let resolvedLinks = case nameType' of - NTContact -> nrSimplexContact - NTPublicGroup -> nrSimplexChannel - -- §4.6: a name verifies when its proof is signed by the resolved name's owner key (selected by - -- linkOwnerId — root key for Nothing, owner-chain key for a channel's Just oid) AND the proof's - -- presHeader is the link the peer was actually connected through (anti-replay). The key comes from - -- *resolving the name* (the address), not the connected link — for a 1-time invite they differ. - -- Maybe Bool: Nothing = not attempted (no proof / no link anchor) — leave the stored status untouched; - -- Just b = a verdict to persist. A network/agent error fetching a resolved link propagates so the - -- UI-triggered verify surfaces it for retry (as a resolveSimplexName failure already does), not a false verdict. - verified <- case (proof_, connLink_) of - (Just proof, Just connLink) - | proofBoundTo proof connLink -> Just . or <$> mapM (verifyProofKey claim proof) resolvedLinks - | otherwise -> pure (Just False) - _ -> pure Nothing - forM_ verified $ \v -> withStore' $ \db -> persistVerified db v - pure $ CRSimplexNameVerified user chatRef claim (verified == Just True) - where - -- the claim, the link the peer was connected through (the presHeader anchor), the proof, and the 3-state persist callback - loadClaimAndLink :: StoreCxt -> CM (SimplexNameInfo, Maybe AConnShortLink, Maybe NameClaimProof, DB.Connection -> Bool -> IO ()) - loadClaimAndLink cxt = case chatRef of - ChatRef CTDirect cId _ -> do - ct <- withFastStore $ \db -> getContact db cxt user cId - let Contact {contactId, profile = LocalProfile {contactDomain, contactDomainProof}, preparedContact} = ct - claim <- maybe (throwCmdError "contact has no name to verify") pure contactDomain - let connLink_ = preparedContact >>= \PreparedContact {connLinkToConnect = ACCL m (CCLink _ sLnk_)} -> ACSL m <$> sLnk_ - pure (claim, connLink_, contactDomainProof, \db verified -> setContactDomainVerified db user contactId verified) - ChatRef CTGroup gId _ -> do - g <- withFastStore $ \db -> getGroupInfo db cxt user gId - let GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}, preparedGroup} = g - gName = unStrJSON <$> (publicGroup >>= publicGroupAccess >>= groupDomain) - gProof = publicGroup >>= publicGroupAccess >>= groupDomainProof - claim <- maybe (throwCmdError "group has no name to verify") pure gName - let connLink_ = preparedGroup >>= \PreparedGroup {connLinkToConnect = CCLink _ sLnk_} -> ACSL SCMContact <$> sLnk_ - pure (claim, connLink_, gProof, \db verified -> setGroupDomainVerified db user groupId verified) - _ -> throwCmdError "APIVerifySimplexName supports only direct and group chat refs" - -- the proof must be bound (anti-replay) to the link the peer was connected through - proofBoundTo :: NameClaimProof -> AConnShortLink -> Bool - proofBoundTo NameClaimProof {presHeader} connLink = - maybe False (`sameConnShortLink` connLink) (proofPresHeaderLink presHeader) - -- verify the proof signature against the resolved name's owner key - -- Maybe Bool: Just = a determined result for this resolved link; Nothing = couldn't fetch it - -- (network/agent error) so the result is undetermined — never recorded as a failed verification. - -- getShortLinkConnReq's network/agent error propagates (UI can retry), not recorded as a verdict - verifyProofKey :: SimplexNameInfo -> NameClaimProof -> Text -> CM Bool - verifyProofKey claim proof@NameClaimProof {linkOwnerId} resolvedText = - case strDecode (encodeUtf8 resolvedText) :: Either String AConnectionLink of - Right (ACL SCMContact (CLShort sLnk)) -> do - (FixedLinkData {rootKey}, ContactLinkData _ UserContactData {owners}) <- getShortLinkConnReq nm user sLnk - let key_ = case linkOwnerId of - Nothing -> Just rootKey - Just (StrJSON oid) -> ownerKey <$> find (\OwnerAuth {ownerId} -> ownerId == oid) owners - pure $ maybe False (\key -> verifyNameProofSig key claim proof) key_ - _ -> pure False + ct <- withFastStore $ \db -> getContact db cxt user contactId + let Contact {profile = LocalProfile {contactDomain, contactDomainProof}, preparedContact} = ct + connLink_ = preparedContact >>= \PreparedContact {connLinkToConnect = ACCL m (CCLink _ sLnk_)} -> ACSL m <$> sLnk_ + claim <- maybe (throwCmdError "contact has no name to verify") pure contactDomain + outcome <- verifyName user nm claim connLink_ contactDomainProof + forM_ (nameVerifyVerdict outcome) $ \v -> withStore' $ \db -> setContactDomainVerified db user contactId v + ct' <- withFastStore $ \db -> getContact db cxt user contactId + pure $ CRContactNameVerified user ct' (nameVerifyReason outcome) + +-- | Verify a public group's (channel's) claimed name (§4.6). +apiVerifyPublicGroupName :: User -> NetworkRequestMode -> GroupId -> CM ChatResponse +apiVerifyPublicGroupName user nm groupId = do + cxt <- chatStoreCxt + g <- withFastStore $ \db -> getGroupInfo db cxt user groupId + let GroupInfo {groupProfile = GroupProfile {publicGroup}, preparedGroup} = g + gName = unStrJSON <$> (publicGroup >>= publicGroupAccess >>= groupDomain) + gProof = publicGroup >>= publicGroupAccess >>= groupDomainProof + connLink_ = preparedGroup >>= \PreparedGroup {connLinkToConnect = CCLink _ sLnk_} -> ACSL SCMContact <$> sLnk_ + claim <- maybe (throwCmdError "group has no name to verify") pure gName + outcome <- verifyName user nm claim connLink_ gProof + forM_ (nameVerifyVerdict outcome) $ \v -> withStore' $ \db -> setGroupDomainVerified db user groupId v + g' <- withFastStore $ \db -> getGroupInfo db cxt user groupId + pure $ CRGroupNameVerified user g' (nameVerifyReason outcome) data ConnectViaContactResult = CVRConnectedContact Contact @@ -5577,7 +5605,8 @@ chatCommandP = "/_set conn user :" *> (APIChangeConnectionUser <$> A.decimal <* A.space <*> A.decimal), ("/connect" <|> "/c") *> (AddContact <$> incognitoP), ("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeTill isSpace $> Nothing)), - "/_verify simplex name " *> (APIVerifySimplexName <$> chatRefP), + "/_verify name @" *> (APIVerifyContactName <$> A.decimal), + "/_verify name #" *> (APIVerifyPublicGroupName <$> A.decimal), ForwardMessage <$> chatNameP <* " <- @" <*> displayNameP <* A.space <*> msgTextP, ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayNameP <* A.space <* A.char '@' <*> (Just <$> displayNameP) <* A.space <*> msgTextP, ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayNameP <*> pure Nothing <* A.space <*> msgTextP, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 696f55b2ff..ea3518e5f4 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -147,7 +147,8 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte CRContactRatchetSyncStarted {} -> ["connection synchronization started"] CRGroupMemberRatchetSyncStarted {} -> ["connection synchronization started"] CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code] - CRSimplexNameVerified u _chatRef ni verified -> ttyUser u ["simplex name " <> plain (shortNameInfoStr ni) <> if verified then " verified" else " not verified"] + CRContactNameVerified u (Contact {profile = LocalProfile {contactDomain}}) result -> ttyUser u $ viewNameVerified contactDomain result + CRGroupNameVerified u g result -> ttyUser u $ viewNameVerified (groupDomainName g) result CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView CRNewChatItems u chatItems -> viewChatItems ttyUser unmuted u chatItems ts tz testView @@ -1138,6 +1139,28 @@ groupDomainName :: GroupInfo -> Maybe SimplexNameInfo groupDomainName GroupInfo {groupProfile = GroupProfile {publicGroup}} = unStrJSON <$> (publicGroup >>= publicGroupAccess >>= groupDomain) +-- §4.7: the name-verification result line — "verified", or "not verified" with the reason. +viewNameVerified :: Maybe SimplexNameInfo -> Maybe Text -> [StyledString] +viewNameVerified name_ result = + let nameStr = maybe "name" (\ni -> "simplex name " <> shortNameInfoStr ni) name_ + in case result of + Nothing -> [plain nameStr <> " verified"] + Just reason -> [plain nameStr <> " not verified: " <> plain reason] + +-- §4.7: show a peer's claimed name only with its verification context — "verified" / "verification +-- failed" when a status is recorded, "unverified" when there is a proof but no status yet, and nothing +-- at all when there is neither (an unproven, unverifiable claim is not shown). +simplexNameStatus :: Maybe SimplexNameInfo -> Maybe Bool -> Bool -> [StyledString] +simplexNameStatus Nothing _ _ = [] +simplexNameStatus (Just ni) status hasProof = case status of + Just True -> [line "verified"] + Just False -> [line "verification failed"] + Nothing + | hasProof -> [line "unverified"] + | otherwise -> [] + where + line s = "simplex name: " <> plain (shortNameInfoStr ni) <> " (" <> s <> ")" + -- TODO [short links] show all settings viewAddressSettings :: AddressSettings -> [StyledString] viewAddressSettings AddressSettings {businessAddress, autoAccept, autoReply} = case autoAccept of @@ -1791,11 +1814,12 @@ viewContactBadge = maybe [] $ \lb -> in [plain (textEncode badgeType <> " badge - " <> st), plain expiry] viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString] -viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge, contactDomain}, activeConn, uiThemes, customData} stats incognitoProfile = +viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge, contactDomain, contactDomainVerification, contactDomainProof}, activeConn, uiThemes, customData} stats incognitoProfile = ["contact ID: " <> sShow contactId] <> viewContactBadge localBadge <> maybe [] viewConnectionStats stats - <> maybe [] (\l -> ["contact address: " <> plain (shareLinkStr contactDomain (strEncode (simplexChatContact' l)))]) contactLink + <> maybe [] (\l -> ["contact address: " <> plain (strEncode (simplexChatContact' l))]) contactLink + <> simplexNameStatus contactDomain contactDomainVerification (isJust contactDomainProof) <> maybe ["you've shared main profile with this contact"] (\p -> ["you've shared incognito profile with this contact: " <> incognitoProfile' p]) @@ -2132,12 +2156,12 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case ILPOwnLink -> [invLink "own link"] ILPConnecting Nothing -> [invLink "connecting"] ILPConnecting (Just ct) -> [invLink ("connecting to contact " <> ttyContact' ct)] - ILPKnown ct@Contact {profile = LocalProfile {contactDomain = sn}} - | nextConnectPrepared ct -> [invLink ("known prepared contact " <> ttyContact' ct)] <> simplexNameLine sn - | contactDeleted ct -> [invLink ("known deleted contact " <> ttyContact' ct)] <> simplexNameLine sn + ILPKnown ct + | nextConnectPrepared ct -> [invLink ("known prepared contact " <> ttyContact' ct)] <> contactNameLine ct + | contactDeleted ct -> [invLink ("known deleted contact " <> ttyContact' ct)] <> contactNameLine ct | otherwise -> [invLink ("known contact " <> ttyContact' ct)] - <> simplexNameLine sn + <> contactNameLine ct <> ["use " <> ttyToContact' ct <> highlight' "" <> " to send messages"] where invLink = ("invitation link: " <>) @@ -2150,13 +2174,13 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case CAPOwnLink -> [ctAddr "own address"] CAPConnectingConfirmReconnect -> [ctAddr "connecting, allowed to reconnect"] CAPConnectingProhibit ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)] - CAPKnown ct@Contact {profile = LocalProfile {contactDomain = sn}} - | nextConnectPrepared ct -> [ctAddr ("known prepared contact " <> ttyContact' ct)] <> simplexNameLine sn + CAPKnown ct + | nextConnectPrepared ct -> [ctAddr ("known prepared contact " <> ttyContact' ct)] <> contactNameLine ct | otherwise -> [ctAddr ("known contact " <> ttyContact' ct)] - <> simplexNameLine sn + <> contactNameLine ct <> ["use " <> ttyToContact' ct <> highlight' "" <> " to send messages"] - CAPContactViaAddress ct@Contact {profile = LocalProfile {contactDomain = sn}} -> [ctAddr ("known contact without connection " <> ttyContact' ct)] <> simplexNameLine sn + CAPContactViaAddress ct -> [ctAddr ("known contact without connection " <> ttyContact' ct)] <> contactNameLine ct where ctAddr = ("contact address: " <>) addrOrBiz = \case @@ -2177,17 +2201,16 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case Just PreparedGroup {connLinkStartedConnection} -> case memberStatus m of GSMemUnknown | connLinkStartedConnection -> connecting g - | otherwise -> [knownGroup "prepared "] <> simplexNameLine sn + | otherwise -> [knownGroup "prepared "] <> groupNameLine g GSMemAccepted -> connecting g _ - | memberRemoved m -> [knownGroup "deleted "] <> simplexNameLine sn -- it should not get here, as this plan is returned as GLPOk + | memberRemoved m -> [knownGroup "deleted "] <> groupNameLine g -- it should not get here, as this plan is returned as GLPOk | otherwise -> knownActive _ -> knownActive where - sn = groupDomainName g knownActive = [knownGroup ""] - <> simplexNameLine sn + <> groupNameLine g <> ["use " <> ttyToGroup g Nothing <> highlight' "" <> " to send messages"] knownGroup prepared = grpOrBizLink g <> ": known " <> prepared <> grpOrBiz g <> " " <> ttyGroup' g GLPNoRelays _ -> [grpLink "channel has no active relays, please try to join later"] @@ -2206,8 +2229,12 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case nextConnectPrepared Contact {preparedContact, activeConn} = case preparedContact of Just _ -> maybe True (\c -> connStatus c == ConnPrepared) activeConn _ -> False - simplexNameLine :: Maybe SimplexNameInfo -> [StyledString] - simplexNameLine = maybe [] (\ni -> ["simplex name: " <> plain (shortNameInfoStr ni)]) + contactNameLine :: Contact -> [StyledString] + contactNameLine Contact {profile = LocalProfile {contactDomain, contactDomainVerification, contactDomainProof}} = + simplexNameStatus contactDomain contactDomainVerification (isJust contactDomainProof) + groupNameLine :: GroupInfo -> [StyledString] + groupNameLine g'@GroupInfo {groupDomainVerification, groupProfile = GroupProfile {publicGroup}} = + simplexNameStatus (groupDomainName g') groupDomainVerification (isJust (publicGroup >>= publicGroupAccess >>= groupDomainProof)) viewSigVerification = \case Just OVVerified -> ["owner signature: verified"] Just (OVFailed r) -> ["owner signature: FAILED (" <> plain r <> ")"] @@ -2660,7 +2687,6 @@ viewChatError isCmd logLevel testView = \case CEChatStoreChanged -> ["error: chat store changed, please restart chat"] CEInvalidConnReq -> viewInvalidConnReq CESimplexNameNotFound ni -> ["no contact or group with simplex name " <> plain (shortNameInfoStr ni)] - CESimplexNameUnprepared ni -> [plain (shortNameInfoStr ni) <> " is a known contact/group but has no link to reconnect via"] CEUnsupportedConnReq -> [ "", "Connection link is not supported by the your app version, please ugrade it.", plain updateStr] CEInvalidChatMessage Connection {connId} msgMeta_ msg e -> [ plain $