diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index eeaa735ecc..98f9592583 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2075,7 +2075,7 @@ processChatCommand cxt nm = \case groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences groupProfile = businessGroupProfile profile groupPreferences gVar <- asks random - (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user groupProfile True ccLink welcomeSharedMsgId False GRMember Nothing + (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user groupProfile True ccLink welcomeSharedMsgId False GRMember Nothing Nothing hostMember <- maybe (throwCmdError "no host member") pure hostMember_ void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) let cd = CDGroupRcv gInfo Nothing hostMember @@ -2088,7 +2088,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 + ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId Nothing 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 @@ -2103,7 +2103,7 @@ processChatCommand cxt nm = \case APIPrepareGroup userId ccLink direct groupSLinkData -> withUserId userId $ \user -> do let GroupShortLinkData {groupProfile = GroupProfile {description}} = groupSLinkData welcomeSharedMsgId <- forM description $ \_ -> getSharedMsgId - (gInfo, hostMember_) <- preparedGroupFromLink user ccLink direct groupSLinkData welcomeSharedMsgId + (gInfo, hostMember_) <- preparedGroupFromLink user ccLink direct groupSLinkData welcomeSharedMsgId Nothing 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 @@ -4199,13 +4199,18 @@ processChatCommand cxt nm = \case l' <- resolveSLink nl' (FixedLinkData {linkConnReq = cReq, rootKey}, cData) <- getShortLinkConnReq nm user l' withFastStore' (\db -> getContactWithoutConnViaShortAddress db cxt user l') >>= \case - Just ct' | not (contactDeleted ct') -> verified (con l' cReq, CPContactAddress (CAPContactViaAddress ct')) + Just ct' | not (contactDeleted ct') -> pure (con l' cReq, CPContactAddress (CAPContactViaAddress ct')) _ -> do contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData) let ContactLinkData _ UserContactData {owners} = cData ov = verifyLinkOwner rootKey owners l' sig_ plan <- contactRequestPlan user cReq contactSLinkData_ ov - verified (con l' cReq, plan) + case (nl, plan) of + (CTName ni, CPContactAddress (CAPOk (Just ContactShortLinkData {profile = p@Profile {contactDomain = cd, contactDomainProof = cdp}}) _)) -> do + domainVerified <- verifyNameClaim ni (unStrJSON <$> cd) cdp (ACSL SCMContact l') rootKey owners + ct <- withStore $ \db -> createPreparedContact db cxt user p (con l' cReq) Nothing domainVerified + pure (con l' cReq, CPContactAddress (CAPKnown ct)) + _ -> pure (con l' cReq, plan) where knownLinkPlans = withFastStore $ \db -> liftIO (getUserContactLinkViaTarget db user nl') >>= \case @@ -4230,9 +4235,6 @@ processChatCommand cxt nm = \case CTName ni -> serverShortLink <$> resolveNameLink user ni 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 []))) - verified r = case nl of - CTName ni -> verifyConnectedName user ni (fst r) (snd r) - CTLink _ -> pure r groupShortLinkPlan = knownLinkPlans >>= \case Just (_, CPGroupLink (GLPKnown g _ _ _)) @@ -4243,8 +4245,8 @@ processChatCommand cxt nm = \case (fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays})) <- getShortLinkConnReq' nm user l' groupSLinkData_ <- liftIO $ decodeLinkUserData cData if - | not direct && unsupportedGroupType groupSLinkData_ -> verified (con l' (linkConnReq fd), CPGroupLink (GLPUpdateRequired groupSLinkData_)) - | not direct && null relays -> verified (con l' (linkConnReq fd), CPGroupLink (GLPNoRelays groupSLinkData_)) + | not direct && unsupportedGroupType groupSLinkData_ -> pure (con l' (linkConnReq fd), CPGroupLink (GLPUpdateRequired groupSLinkData_)) + | not direct && null relays -> pure (con l' (linkConnReq fd), CPGroupLink (GLPNoRelays groupSLinkData_)) | otherwise -> do let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId} @@ -4256,7 +4258,15 @@ processChatCommand cxt nm = \case _ -> throwChatError CEInvalidConnReq let ov = verifyLinkOwner rootKey owners l' sig_ plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov - verified (con l' cReq, plan) + case (nl, plan) of + (CTName ni, CPGroupLink (GLPOk (Just _) (Just gld) _)) -> do + let GroupShortLinkData {groupProfile = GroupProfile {publicGroup = pg}} = gld + gName = unStrJSON <$> (pg >>= publicGroupAccess >>= groupDomain) + gProof = pg >>= publicGroupAccess >>= groupDomainProof + domainVerified <- verifyNameClaim ni gName gProof (ACSL SCMContact l') rootKey owners + (g, _) <- preparedGroupFromLink user (CCLink cReq (Just l')) direct gld Nothing domainVerified + pure (con l' cReq, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef []))) + _ -> pure (con l' cReq, plan) where unsupportedGroupType = \case Just GroupShortLinkData {groupProfile = GroupProfile {publicGroup = Just PublicGroupProfile {groupType}}} -> groupType /= GTChannel @@ -4284,29 +4294,6 @@ processChatCommand cxt nm = \case NTContact -> (nrSimplexContact, CCTContact) NTPublicGroup -> (nrSimplexChannel, CCTChannel) maybe (throwChatError $ CESimplexName ni SNENoValidLink) pure $ firstNameLink ctType candidates - verifyConnectedName :: User -> SimplexNameInfo -> ACreatedConnLink -> ConnectionPlan -> CM (ACreatedConnLink, ConnectionPlan) - verifyConnectedName user ni ccLink plan = case plan of - CPContactAddress (CAPOk (Just ContactShortLinkData {profile}) _) -> do - ct <- withStore $ \db -> createPreparedContact db cxt user profile ccLink Nothing - verifiedContactPlan ct - CPContactAddress (CAPKnown ct) -> verifiedContactPlan ct - CPGroupLink (GLPOk (Just GroupShortLinkInfo {direct}) (Just gld) _) - | ACCL SCMContact ccl <- ccLink -> do - (g, _) <- preparedGroupFromLink user ccl direct gld Nothing - verifiedGroupPlan g - CPGroupLink (GLPKnown g _ _ _) -> verifiedGroupPlan g - _ -> pure (ccLink, plan) - where - verifiedContactPlan Contact {contactId, profile = LocalProfile {contactDomain}} = do - unless (contactDomain == Just ni) $ throwChatError $ CESimplexName ni SNEUnknownName - withStore' $ \db -> setContactDomainVerified db user contactId True - ct' <- withFastStore $ \db -> getContact db cxt user contactId - pure (ccLink, CPContactAddress (CAPKnown ct')) - verifiedGroupPlan GroupInfo {groupId, groupProfile = GroupProfile {publicGroup}} = do - unless ((publicGroup >>= publicGroupAccess >>= groupDomain) == Just (StrJSON ni)) $ throwChatError $ CESimplexName ni SNEUnknownName - withStore' $ \db -> setGroupDomainVerified db user groupId True - g' <- withFastStore $ \db -> getGroupInfo db cxt user groupId - pure (ccLink, CPGroupLink (GLPKnown g' (BoolDef False) Nothing (ListDef []))) connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse connectWithPlan user@User {userId} incognito ccLink plan | connectionPlanProceed plan = do @@ -4747,14 +4734,14 @@ processChatCommand cxt nm = \case gInfo <- withFastStore $ \db -> getGroupInfo db cxt user gId a $ SRGroup gId scope (sendAsGroup' gInfo scope) _ -> throwCmdError "not supported" - preparedGroupFromLink :: User -> CreatedLinkContact -> DirectLink -> GroupShortLinkData -> Maybe SharedMsgId -> CM (GroupInfo, Maybe GroupMember) - preparedGroupFromLink user ccLink direct groupSLinkData welcomeSharedMsgId = do + preparedGroupFromLink :: User -> CreatedLinkContact -> DirectLink -> GroupShortLinkData -> Maybe SharedMsgId -> Maybe Bool -> CM (GroupInfo, Maybe GroupMember) + preparedGroupFromLink user ccLink direct groupSLinkData welcomeSharedMsgId domainVerified = do let GroupShortLinkData {groupProfile = gp, publicGroupData = publicGroupData_} = groupSLinkData publicMemberCount_ = (\PublicGroupData {publicMemberCount} -> publicMemberCount) <$> publicGroupData_ useRelays = not direct subRole <- if useRelays then asks $ channelSubscriberRole . config else pure GRMember gVar <- asks random - withStore $ \db -> createPreparedGroup db gVar cxt user gp False ccLink welcomeSharedMsgId useRelays subRole publicMemberCount_ + withStore $ \db -> createPreparedGroup db gVar cxt user gp False ccLink welcomeSharedMsgId useRelays subRole publicMemberCount_ domainVerified getSharedMsgId :: CM SharedMsgId getSharedMsgId = do @@ -4830,16 +4817,25 @@ proofBoundTo NameClaimProof {presHeader} connLink = -- 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 = +verifyProofKey nm user claim proof 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 $ proofSignedByOwner rootKey owners claim proof _ -> pure False +proofSignedByOwner :: C.PublicKeyEd25519 -> [OwnerAuth] -> SimplexNameInfo -> NameClaimProof -> Bool +proofSignedByOwner rootKey owners claim proof@NameClaimProof {linkOwnerId} = + let key_ = case linkOwnerId of + Nothing -> Just rootKey + Just (StrJSON oid) -> ownerKey <$> find (\OwnerAuth {ownerId} -> ownerId == oid) owners + in maybe False (\key -> verifyNameProofSig key claim proof) key_ + +verifyNameClaim :: SimplexNameInfo -> Maybe SimplexNameInfo -> Maybe NameClaimProof -> AConnShortLink -> C.PublicKeyEd25519 -> [OwnerAuth] -> CM (Maybe Bool) +verifyNameClaim ni claimedName_ proof_ connLink rootKey owners = do + unless (claimedName_ == Just ni) $ throwChatError $ CESimplexName ni SNEUnknownName + pure $ (\p -> proofBoundTo p connLink && proofSignedByOwner rootKey owners ni p) <$> proof_ + nameVerifyVerdict :: NameVerifyOutcome -> Maybe Bool nameVerifyVerdict = \case NVOVerified -> Just True diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index c8fc09c515..eb3d74c762 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -401,12 +401,13 @@ createIncognitoProfile db User {userId} p = do createdAt <- getCurrentTime createIncognitoProfile_ db userId createdAt p -createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact -createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId = do +createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> Maybe Bool -> ExceptT StoreError IO Contact +createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId domainVerified = do currentTs <- liftIO getCurrentTime let prepared = Just (connLinkToConnect, welcomeSharedMsgId) ctUserPreferences = newContactUserPrefs user p contactId <- createContact_ db cxt user p ctUserPreferences prepared "" currentTs + forM_ domainVerified $ \v -> liftIO $ setContactDomainVerified db user contactId v getContact db cxt user contactId updatePreparedContactUser :: DB.Connection -> StoreCxt -> User -> Contact -> User -> ExceptT StoreError IO Contact diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index a8516e587a..ba849ceacf 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -643,8 +643,8 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile { DB.execute db "DELETE FROM contacts WHERE contact_id = ?" (Only contactId) DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId) -createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> StoreCxt -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember) -createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ = do +createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> StoreCxt -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> Maybe Bool -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember) +createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ domainVerified = do currentTs <- liftIO getCurrentTime let prepared = Just (connLinkToConnect, welcomeSharedMsgId) (groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs @@ -662,6 +662,7 @@ createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile b hostMember_ <- forM hostMemberId_ $ getGroupMember db cxt user groupId forM_ hostMember_ $ \hostMember -> when business $ liftIO $ setGroupBusinessChatInfo groupId membership hostMember + forM_ domainVerified $ \v -> liftIO $ setGroupDomainVerified db user groupId v g <- getGroupInfo db cxt user groupId pure (g, hostMember_) where