dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-09-02 00:28:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

configurable badge key

Browse Source
This commit is contained in:
Evgeny @ SimpleX Chat
2026-06-09 13:01:46 +00:00
parent ea4db3ac53
commit cca62e949f
11 changed files with 82 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+2
View File
@@ -29,6 +29,7 @@ import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime, nominalDay)
import Simplex.Chat.Controller
import Simplex.Messaging.Crypto.BBS (BBSPublicKey (..))
import Simplex.Chat.Library.Commands
import Simplex.Chat.Operators
import Simplex.Chat.Operators.Presets
@@ -65,6 +66,7 @@ defaultChatConfig =
tbqSize = 1024
},
chatVRange = supportedChatVRange,
badgePublicKey = BBSPublicKey "",
confirmMigrations = MCConsole,
-- this property should NOT use operator = Nothing
-- non-operator servers can be passed via options
src/Simplex/Chat/Controller.hs
+3 -1
View File
@@ -81,6 +81,7 @@ import Simplex.Messaging.Agent.Store.DB (SQLError)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Client (HostMode (..), SMPProxyFallback (..), SMPProxyMode (..), SMPWebPortServers (..), SocksMode (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
import Simplex.Messaging.Crypto.File (CryptoFile (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Crypto.Ratchet (PQEncryption)
@@ -137,6 +138,7 @@ coreVersionInfo simplexmqCommit =
data ChatConfig = ChatConfig
{ agentConfig :: AgentConfig,
chatVRange :: VersionRangeChat,
badgePublicKey :: BBSPublicKey,
confirmMigrations :: MigrationConfirmation,
presetServers :: PresetServers,
shortLinkPresetServers :: NonEmpty SMPServer,
@@ -172,7 +174,7 @@ data ChatConfig = ChatConfig
-- | Builds the read-only context threaded through store functions from chat config.
-- The single construction point, so new store-wide config (e.g. server keys) is added in one place.
mkStoreCxt :: ChatConfig -> StoreCxt
mkStoreCxt ChatConfig {chatVRange} = StoreCxt chatVRange
mkStoreCxt ChatConfig {chatVRange, badgePublicKey} = StoreCxt chatVRange badgePublicKey
{-# INLINE mkStoreCxt #-}
data RandomAgentServers = RandomAgentServers
src/Simplex/Chat/Library/Commands.hs
+6 -6
View File
@@ -363,16 +363,16 @@ processChatCommand cxt nm = \case
user <- withFastStore $ \db -> do
user <- createUserRecordAt db (AgentUserId auId) p userChatRelay True ts
mapM_ (setUserServers db user ts) uss
createPresetContactCards db user `catchAllErrors` \_ -> pure ()
createPresetContactCards db cxt user `catchAllErrors` \_ -> pure ()
createNoteFolder db user
pure user
atomically . writeTVar u $ Just user
pure $ CRActiveUser user
where
createPresetContactCards :: DB.Connection -> User -> ExceptT StoreError IO ()
createPresetContactCards db user = do
createContact db user simplexStatusContactProfile
createContact db user simplexTeamContactProfile
createPresetContactCards :: DB.Connection -> StoreCxt -> User -> ExceptT StoreError IO ()
createPresetContactCards db cxt user = do
createContact db cxt user simplexStatusContactProfile
createContact db cxt user simplexTeamContactProfile
chooseServers :: Maybe User -> CM ([UpdatedUserOperatorServers], (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
chooseServers user_ = do
as <- asks randomAgentServers
@@ -3624,7 +3624,7 @@ processChatCommand cxt nm = \case
relayLinkData_ <- liftIO $ decodeLinkUserData cData
case (relayLinkData_, linkEntityId) of
(Just RelayShortLinkData {relayProfile = p}, Just entityId) ->
withFastStore $ \db -> updateRelayMemberData db user relayMember (MemberId entityId) (MemberKey relayKey) p
withFastStore $ \db -> updateRelayMemberData db cxt user relayMember (MemberId entityId) (MemberKey relayKey) p
_ -> throwChatError $ CEException "relay link: no relay link data or entity id"
let cReq = linkConnReq fd
relayLinkToConnect = CCLink cReq (Just relayLink)
src/Simplex/Chat/Library/Internal.hs
+4 -4
View File
@@ -947,8 +947,9 @@ acceptGroupJoinRequestAsync
memberKey_ = do
gVar <- asks random
let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
cxt <- chatStoreCxt
(groupMemberId, memberId) <- withStore $ \db ->
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
let currentMemCount = fromIntegral $ currentMembers $ groupSummary gInfo
let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile)
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
@@ -964,7 +965,6 @@ acceptGroupJoinRequestAsync
groupSize = Just currentMemCount
}
subMode <- chatReadVar subscriptionMode
cxt <- chatStoreCxt
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
withStore $ \db -> do
@@ -982,8 +982,9 @@ acceptGroupJoinSendRejectAsync
cReqXContactId_
rejectionReason = do
gVar <- asks random
cxt <- chatStoreCxt
(groupMemberId, memberId) <- withStore $ \db ->
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing Nothing GRObserver GSMemRejected Nothing
createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing Nothing GRObserver GSMemRejected Nothing
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
msg =
XGrpLinkReject $
@@ -994,7 +995,6 @@ acceptGroupJoinSendRejectAsync
rejectionReason
}
subMode <- chatReadVar subscriptionMode
cxt <- chatStoreCxt
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user False cReqInvId msg subMode PQSupportOff chatV
withStore $ \db -> do
src/Simplex/Chat/Library/Subscriber.hs
+9 -9
View File
@@ -1170,7 +1170,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
relayLinkData_ <- liftIO $ decodeLinkUserData cData
case (relayLinkData_, linkEntityId) of
(Just RelayShortLinkData {relayProfile = p}, Just entityId) ->
withStore $ \db -> updateRelayMemberData db user m (MemberId entityId) (MemberKey relayKey) p
withStore $ \db -> updateRelayMemberData db cxt user m (MemberId entityId) (MemberKey relayKey) p
_ -> throwChatError $ CEException "relay link: no relay link data or entity id"
case cReq of
CRContactUri crData@ConnReqUriData {crClientData} -> do
@@ -2553,10 +2553,10 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
| p /= p' = do
c' <- withStore $ \db ->
if userTTL == rcvTTL
then updateContactProfile db user c p'
then updateContactProfile db cxt user c p'
else do
c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
updateContactProfile db user c' p'
updateContactProfile db cxt user c' p'
when (directOrUsed c' && createItems) $ do
createProfileUpdatedItem c'
lift $ createRcvFeatureItems user c c'
@@ -2671,7 +2671,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
updateBusinessChatProfile gInfo
case memberContactId of
Nothing -> do
m' <- withStore $ \db -> updateMemberProfile db user m p'
m' <- withStore $ \db -> updateMemberProfile db cxt user m p'
unless (muteEventInChannel gInfo m') $ do
forM_ msgTs_ $ createProfileUpdatedItem m'
toView $ CEvtGroupMemberUpdated user gInfo m m'
@@ -2680,7 +2680,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
mCt <- withStore $ \db -> getContact db cxt user mContactId
if canUpdateProfile mCt
then do
(m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p'
(m', ct') <- withStore $ \db -> updateContactMemberProfile db cxt user m mCt p'
unless (muteEventInChannel gInfo m') $ do
forM_ msgTs_ $ createProfileUpdatedItem m'
toView $ CEvtGroupMemberUpdated user gInfo m m'
@@ -2976,7 +2976,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
| otherwise -> messageError "x.grp.mem.new error: member already exists" $> Nothing
Left _ -> do
(newMember, gInfo') <- withStore $ \db -> do
newMember <- createNewGroupMember db user gInfo m memInfo GCPostMember initialStatus
newMember <- createNewGroupMember db cxt user gInfo m memInfo GCPostMember initialStatus
gInfo' <-
if memberPending newMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
@@ -3028,7 +3028,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
MemberInfo mId mRole v p _
| mRole == GROwner -> MemberInfo mId mRole v p Nothing
_ -> memInfo
void $ withStore $ \db -> createIntroReMember db user gInfo memInfo' memRestrictions
void $ withStore $ \db -> createIntroReMember db cxt user gInfo memInfo' memRestrictions
| otherwise -> do
when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c)
case memChatVRange of
@@ -3040,7 +3040,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
groupConnIds <- createConn subMode
let chatV = maybe (minVersion (vr cxt)) (\peerVR -> vr cxt `peerConnChatVersion` fromChatVRange peerVR) memChatVRange
void $ withStore $ \db -> do
reMember <- createIntroReMember db user gInfo memInfo memRestrictions
reMember <- createIntroReMember db cxt user gInfo memInfo memRestrictions
createIntroReMemberConn db user m reMember chatV memInfo groupConnIds subMode
| otherwise -> messageError "x.grp.mem.intro: member chat version range incompatible"
_ -> messageError "x.grp.mem.intro can be only sent by host member"
@@ -3075,7 +3075,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
-- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
-- For now, this branch compensates for the lack of delayed message delivery.
`catchError` \case
SEGroupMemberNotFoundByMemberId _ -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
SEGroupMemberNotFoundByMemberId _ -> createNewGroupMember db cxt user gInfo m memInfo GCPostMember GSMemAnnounced
e -> throwError e
-- TODO [knocking] separate pending statuses from GroupMemberStatus?
-- TODO add GSMemIntroInvitedPending, GSMemConnectedPending, etc.?
src/Simplex/Chat/Store/ContactRequest.hs
+2 -2
View File
@@ -163,7 +163,7 @@ createOrUpdateContactRequest
createContactRequest :: ExceptT StoreError IO RequestStage
createContactRequest = do
currentTs <- liftIO $ getCurrentTime
badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge
badgeVerified <- liftIO $ verifyBadge_ (badgeKey cxt) badge
ExceptT $ withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
liftIO $
DB.execute
@@ -230,7 +230,7 @@ createOrUpdateContactRequest
pure $ RSCurrentRequest (Just ucr) ucr' re_
where
updateProfile currentTs = do
badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge
badgeVerified <- liftIO $ verifyBadge_ (badgeKey cxt) badge
DB.execute
db
[sql|
src/Simplex/Chat/Store/Direct.hs
+5 -5
View File
@@ -402,7 +402,7 @@ createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId = do
currentTs <- liftIO getCurrentTime
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
ctUserPreferences = newContactUserPrefs user p
contactId <- createContact_ db user p ctUserPreferences prepared "" currentTs
contactId <- createContact_ db cxt user p ctUserPreferences prepared "" currentTs
getContact db cxt user contactId
updatePreparedContactUser :: DB.Connection -> StoreCxt -> User -> Contact -> User -> ExceptT StoreError IO Contact
@@ -447,7 +447,7 @@ createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Profil
createDirectContact db cxt user Connection {connId, localAlias} p = do
currentTs <- liftIO getCurrentTime
let ctUserPreferences = newContactUserPrefs user p
contactId <- createContact_ db user p ctUserPreferences Nothing localAlias currentTs
contactId <- createContact_ db cxt user p ctUserPreferences Nothing localAlias currentTs
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
getContact db cxt user contactId
@@ -555,10 +555,10 @@ deleteUnusedProfile_ db userId profileId =
:. (userId, profileId, userId, profileId, profileId)
)
updateContactProfile :: DB.Connection -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile db user@User {userId} c p' = do
updateContactProfile :: DB.Connection -> StoreCxt -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile db cxt user@User {userId} c p' = do
currentTs <- liftIO getCurrentTime
badgeVerified <- liftIO $ profileBadgeVerified lp p'
badgeVerified <- liftIO $ profileBadgeVerified (badgeKey cxt) lp p'
let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified
updateContactProfile' currentTs badgeVerified profile
where
src/Simplex/Chat/Store/Groups.hs
+32 -30
View File
@@ -635,7 +635,7 @@ createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile b
randHostId <- liftIO $ encodedRandomBytes gVar 12
let memberId = MemberId $ encodeUtf8 groupLDN <> "_unknown_host_" <> randHostId
hostProfile = profileFromName $ nameFromBS randHostId
(localDisplayName, profileId, _) <- createNewMemberProfile_ db user hostProfile currentTs
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user hostProfile currentTs
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
liftIO $ do
DB.execute
@@ -790,7 +790,7 @@ updatePreparedUserAndHostMembers'
|]
(memberId, memberRole, membershipStatus, currentTs, groupMemberId' membership)
updateHostMember currentTs = do
_ <- updateMemberProfile db user hostMember fromMemberProfile
_ <- updateMemberProfile db cxt user hostMember fromMemberProfile
let MemberIdRole memberId memberRole = fromMember
gmId = groupMemberId' hostMember
liftIO $
@@ -840,7 +840,7 @@ createGroupViaLink'
(,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user hostMemberId
where
insertHost_ currentTs groupId = do
(localDisplayName, profileId, _) <- createNewMemberProfile_ db user fromMemberProfile currentTs
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs
let MemberIdRole {memberId, memberRole} = fromMember
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
liftIO $ do
@@ -1375,7 +1375,7 @@ createRelayForOwner :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> Gr
createRelayForOwner db cxt gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do
currentTs <- liftIO getCurrentTime
let relayProfile = profileFromName displayName
(localDisplayName, memProfileId, _) <- createNewMemberProfile_ db user relayProfile currentTs
(localDisplayName, memProfileId, _) <- createNewMemberProfile_ db cxt user relayProfile currentTs
groupMemberId <- createWithRandomId' db gVar $ \memId -> runExceptT $ do
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
liftIO $
@@ -1414,7 +1414,7 @@ getCreateRelayForMember db cxt gVar user@User {userId, userContactId} GroupInfo
randRelayId <- liftIO $ encodedRandomBytes gVar 12
let memberId = MemberId $ encodeUtf8 groupLDN <> "_unknown_relay_" <> randRelayId
relayProfile = profileFromName $ nameFromBS randRelayId
(localDisplayName, profileId, _) <- createNewMemberProfile_ db user relayProfile currentTs
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user relayProfile currentTs
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
groupMemberId <- liftIO $ do
DB.execute
@@ -1487,7 +1487,7 @@ setRelayLinkAccepted db cxt user m (MemberKey relayKey) profile = do
WHERE group_member_id = ?
|]
(relayKey, currentTs, gmId)
void $ updateMemberProfile db user m profile
void $ updateMemberProfile db cxt user m profile
(,) <$> getGroupMemberById db cxt user gmId <*> getGroupRelayByGMId db gmId
setRelayLinkConfId :: DB.Connection -> GroupMember -> ConfirmationId -> ShortLinkContact -> IO ()
@@ -1534,8 +1534,8 @@ getRelayConfId db m =
|]
(Only (groupMemberId' m))
updateRelayMemberData :: DB.Connection -> User -> GroupMember -> MemberId -> MemberKey -> Profile -> ExceptT StoreError IO ()
updateRelayMemberData db user m memberId (MemberKey relayKey) profile = do
updateRelayMemberData :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberId -> MemberKey -> Profile -> ExceptT StoreError IO ()
updateRelayMemberData db cxt user m memberId (MemberKey relayKey) profile = do
currentTs <- liftIO getCurrentTime
liftIO $
DB.execute
@@ -1546,7 +1546,7 @@ updateRelayMemberData db user m memberId (MemberKey relayKey) profile = do
WHERE group_member_id = ?
|]
(memberId, relayKey, currentTs, groupMemberId' m)
void $ updateMemberProfile db user m profile
void $ updateMemberProfile db cxt user m profile
setGroupInProgressDone :: DB.Connection -> GroupInfo -> IO ()
setGroupInProgressDone db GroupInfo {groupId} = do
@@ -1599,7 +1599,7 @@ createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMemb
insertOwner_ currentTs groupId = do
let MemberIdRole {memberId, memberRole} = fromMember
VersionRange minV maxV = reqChatVRange
(localDisplayName, profileId, _) <- createNewMemberProfile_ db user fromMemberProfile currentTs
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
liftIO $ do
DB.execute
@@ -1714,9 +1714,10 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo
:. (minV, maxV)
)
createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId)
createJoiningMember :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId)
createJoiningMember
db
cxt
gVar
User {userId, userContactId}
GroupInfo {groupId, membership}
@@ -1729,7 +1730,7 @@ createJoiningMember
memberStatus
memberKey_ = do
currentTs <- liftIO getCurrentTime
badgeVerified <- liftIO $ verifyBadge_ srvBadgePublicKey badge
badgeVerified <- liftIO $ verifyBadge_ (badgeKey cxt) badge
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
liftIO $
DB.execute
@@ -2071,10 +2072,10 @@ increaseGroupMembersRequireAttention db User {userId} g@GroupInfo {groupId, memb
pure g {membersRequireAttention = membersRequireAttention + 1}
-- | add new member with profile
createNewGroupMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do
createNewGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do
currentTs <- liftIO getCurrentTime
(localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db user profile currentTs
(localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user profile currentTs
let newMember =
NewGroupMember
{ memInfo,
@@ -2089,10 +2090,10 @@ createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} m
}
createNewMember_ db user gInfo newMember badgeVerified currentTs
createNewMemberProfile_ :: DB.Connection -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Bool)
createNewMemberProfile_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences} createdAt =
createNewMemberProfile_ :: DB.Connection -> StoreCxt -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Bool)
createNewMemberProfile_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences} createdAt =
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
badgeVerified <- verifyBadge_ srvBadgePublicKey badge
badgeVerified <- verifyBadge_ (badgeKey cxt) badge
DB.execute
db
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
@@ -2268,15 +2269,16 @@ getMemberRelationsVector db GroupMember {groupMemberId} =
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
(Only groupMemberId)
createIntroReMember :: DB.Connection -> User -> GroupInfo -> MemberInfo -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember
createIntroReMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberInfo -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember
createIntroReMember
db
cxt
user
gInfo
memInfo@(MemberInfo _ _ _ memberProfile _)
memRestrictions_ = do
currentTs <- liftIO getCurrentTime
(localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db user memberProfile currentTs
(localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile currentTs
let memRestriction = restriction <$> memRestrictions_
newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
createNewMember_ db user gInfo newMember badgeVerified currentTs
@@ -3003,10 +3005,10 @@ setMemberContactStartedConnection db Contact {contactId} = do
"UPDATE contacts SET grp_direct_inv_started_connection = ?, updated_at = ? WHERE contact_id = ?"
(BI True, currentTs, contactId)
updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
updateMemberProfile db user@User {userId} m p' = do
updateMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
updateMemberProfile db cxt user@User {userId} m p' = do
currentTs <- liftIO getCurrentTime
badgeVerified <- liftIO $ profileBadgeVerified (memberProfile m) p'
badgeVerified <- liftIO $ profileBadgeVerified (badgeKey cxt) (memberProfile m) p'
let memberProfile = toLocalProfile profileId p' localAlias currentTs badgeVerified
updateMemberProfile' currentTs badgeVerified memberProfile
where
@@ -3026,10 +3028,10 @@ updateMemberProfile db user@User {userId} m p' = do
safeDeleteLDN db user localDisplayName
pure $ Right m {localDisplayName = ldn, memberProfile}
updateContactMemberProfile :: DB.Connection -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
updateContactMemberProfile db user@User {userId} m ct@Contact {contactId} p' = do
updateContactMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} p' = do
currentTs <- liftIO getCurrentTime
badgeVerified <- liftIO $ profileBadgeVerified (memberProfile m) p'
badgeVerified <- liftIO $ profileBadgeVerified (badgeKey cxt) (memberProfile m) p'
let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified
updateContactMemberProfile' currentTs badgeVerified profile
where
@@ -3062,7 +3064,7 @@ createNewUnknownGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo ->
createNewUnknownGroupMember db cxt user@User {userId, userContactId} GroupInfo {groupId} memberId memberName unknownMemberRole = do
currentTs <- liftIO getCurrentTime
let memberProfile = profileFromName memberName
(localDisplayName, profileId, _) <- createNewMemberProfile_ db user memberProfile currentTs
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile currentTs
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
liftIO $
DB.execute
@@ -3087,7 +3089,7 @@ createLinkOwnerMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe
createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupId} contactId_ memberId ownerKey = do
currentTs <- liftIO getCurrentTime
let memberProfile = profileFromName $ nameFromMemberId memberId
(localDisplayName, profileId, _) <- createNewMemberProfile_ db user memberProfile currentTs
(localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile currentTs
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
liftIO $
DB.execute
@@ -3113,7 +3115,7 @@ createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupI
-- Updating from an in-band message would allow a compromised relay to substitute keys.
updatePreparedChannelMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do
_ <- updateMemberProfile db user member profile
_ <- updateMemberProfile db cxt user member profile
currentTs <- liftIO getCurrentTime
liftIO $
DB.execute
@@ -3134,7 +3136,7 @@ updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupM
updateUnknownMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} status = do
_ <- updateMemberProfile db user unknownMember profile
_ <- updateMemberProfile db cxt user unknownMember profile
currentTs <- liftIO getCurrentTime
liftIO $
DB.execute
src/Simplex/Chat/Store/Shared.hs
+6 -6
View File
@@ -407,15 +407,15 @@ setCommandConnId db User {userId} cmdId connId = do
|]
(connId, updatedAt, userId, cmdId)
createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO ()
createContact db user profile = do
createContact :: DB.Connection -> StoreCxt -> User -> Profile -> ExceptT StoreError IO ()
createContact db cxt user profile = do
currentTs <- liftIO getCurrentTime
void $ createContact_ db user profile emptyChatPrefs Nothing "" currentTs
void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs
createContact_ :: DB.Connection -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId
createContact_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
createContact_ :: DB.Connection -> StoreCxt -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId
createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs =
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
badgeVerified <- verifyBadge_ srvBadgePublicKey badge
badgeVerified <- verifyBadge_ (badgeKey cxt) badge
DB.execute
db
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
src/Simplex/Chat/Types.hs
+6 -5
View File
@@ -47,7 +47,8 @@ import Data.Text.Encoding (encodeUtf8)
import Data.Time.Clock (UTCTime)
import Data.Typeable (Typeable)
import Data.Word (Word16)
import Simplex.Chat.Badges (Badge (..), BadgeCrypto (..), BadgeInfo (..), BadgeStatus (..), LocalBadge (..), localBadgeInfo, localBadgeStatus, mkBadgeStatus, srvBadgePublicKey, verifyBadge)
import Simplex.Chat.Badges (Badge (..), BadgeCrypto (..), BadgeInfo (..), BadgeStatus (..), LocalBadge (..), localBadgeInfo, localBadgeStatus, mkBadgeStatus, verifyBadge)
import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
@@ -783,13 +784,13 @@ fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contact
BadgeProof {} -> Just b
BadgeCredential {} -> Nothing
profileBadgeVerified :: LocalProfile -> Profile -> IO Bool
profileBadgeVerified LocalProfile {localBadge} Profile {badge = newBadge} =
profileBadgeVerified :: BBSPublicKey -> LocalProfile -> Profile -> IO Bool
profileBadgeVerified key LocalProfile {localBadge} Profile {badge = newBadge} =
case (localBadge, newBadge) of
(_, Nothing) -> pure False
(Just lb, Just (BadgeProof _ _ newInfo))
| localBadgeInfo lb == newInfo -> pure (localBadgeStatus lb /= BSFailed)
(_, Just newB) -> verifyBadge srvBadgePublicKey newB
(_, Just newB) -> verifyBadge key newB
data GroupType
= GTChannel
@@ -2053,7 +2054,7 @@ type VersionRangeChat = VersionRange ChatVersion
-- | Store-wide context passed to store functions in place of the bare `vr`
-- parameter. Built from config by mkStoreCxt; more fields are added here over time.
newtype StoreCxt = StoreCxt {vr :: VersionRangeChat}
data StoreCxt = StoreCxt {vr :: VersionRangeChat, badgeKey :: BBSPublicKey}
pattern VersionChat :: Word16 -> VersionChat
pattern VersionChat v = Version v
tests/ChatTests/Profiles.hs
+7 -7
View File
@@ -18,7 +18,7 @@ import Control.Monad.Except
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import Simplex.Chat.Controller (ChatConfig (..), ChatHooks (..), defaultChatHooks)
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatHooks (..), defaultChatHooks, mkStoreCxt)
import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
import Simplex.Chat.Protocol (currentChatVersion)
import Simplex.Chat.Store.Shared (createContact)
@@ -1187,13 +1187,13 @@ testPlanAddressContactViaAddress =
Left _ -> error "error parsing contact link"
Right cReq -> do
let profile = aliceProfile {contactLink = Just cReq}
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> let TestCC {chatController = ChatController {config}} = bob in runExceptT $ createContact db (mkStoreCxt config) user profile
bob @@@ [("@alice", "")]
bob ##> "/delete @alice"
bob <## "alice: contact is deleted"
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> let TestCC {chatController = ChatController {config}} = bob in runExceptT $ createContact db (mkStoreCxt config) user profile
bob @@@ [("@alice", "")]
bob ##> ("/_connect plan 1 " <> cLink)
@@ -1208,7 +1208,7 @@ testPlanAddressContactViaAddress =
alice ##> "/delete @bob"
alice <## "bob: contact is deleted"
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> let TestCC {chatController = ChatController {config}} = bob in runExceptT $ createContact db (mkStoreCxt config) user profile
bob @@@ [("@alice", "")]
-- GUI api
@@ -1249,13 +1249,13 @@ testPlanAddressContactViaShortAddress =
Left _ -> error "error parsing contact link"
Right shortLink -> do
let profile = aliceProfile {contactLink = Just shortLink}
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> let TestCC {chatController = ChatController {config}} = bob in runExceptT $ createContact db (mkStoreCxt config) user profile
bob @@@ [("@alice", "")]
bob ##> "/delete @alice"
bob <## "alice: contact is deleted"
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> let TestCC {chatController = ChatController {config}} = bob in runExceptT $ createContact db (mkStoreCxt config) user profile
bob @@@ [("@alice", "")]
bob ##> ("/_connect plan 1 " <> sLink)
@@ -1270,7 +1270,7 @@ testPlanAddressContactViaShortAddress =
alice ##> "/delete @bob"
alice <## "bob: contact is deleted"
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> let TestCC {chatController = ChatController {config}} = bob in runExceptT $ createContact db (mkStoreCxt config) user profile
bob @@@ [("@alice", "")]
-- GUI api