mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-11 15:24:58 +00:00
directory: support public channels and relay-based groups (#6840)
* directory: support public channels and relay-based groups (plan) * types * amend types * directory types, resolve known link * implementation, test fails * fix test * fix test * more test * minimal test * more test * debug test * clean up * remove debug logs * refactor * use group/channel terms correctly * remove unsupported commands * manage profile update * owner left the channel * more tests, correct response to sent link * re-registration * /help and /link commands * correct listing for channels * fix test * fix bot api * refactor * do not include link data in GLPKnown * refactor * diff * undo refactor * simplify * remove harness test * remove flip * add v6.5 app requirement for channels * add website support * update bot api types * correct member count, fix test * members -> subscribers * add link to channel description * fix css * move version note --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny
@@ -470,13 +470,13 @@ data ChatCommand
|
||||
| AddContact IncognitoEnabled
|
||||
| APISetConnectionIncognito Int64 IncognitoEnabled
|
||||
| APIChangeConnectionUser Int64 UserId -- new user id to switch connection to
|
||||
| APIConnectPlan {userId :: UserId, connectionLink :: Maybe AConnectionLink, linkOwnerSig :: Maybe LinkOwnerSig} -- Maybe AConnectionLink is used to report link parsing failure as special error
|
||||
| APIConnectPlan {userId :: UserId, connectionLink :: Maybe AConnectionLink, resolveKnown :: Bool, linkOwnerSig :: Maybe LinkOwnerSig} -- Maybe AConnectionLink is used to report link parsing failure as special error
|
||||
| APIPrepareContact UserId ACreatedConnLink ContactShortLinkData
|
||||
| APIPrepareGroup UserId CreatedLinkContact DirectLink GroupShortLinkData
|
||||
| APIChangePreparedContactUser ContactId UserId
|
||||
| APIChangePreparedGroupUser GroupId UserId
|
||||
| APIConnectPreparedContact {contactId :: ContactId, incognito :: IncognitoEnabled, msgContent_ :: Maybe MsgContent}
|
||||
| APIConnectPreparedGroup GroupId IncognitoEnabled (Maybe MsgContent)
|
||||
| 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, connLink_ :: Maybe AConnectionLink}
|
||||
| APIConnectContactViaAddress UserId IncognitoEnabled ContactId
|
||||
@@ -1037,7 +1037,7 @@ data GroupLinkPlan
|
||||
| GLPOwnLink {groupInfo :: GroupInfo}
|
||||
| GLPConnectingConfirmReconnect
|
||||
| GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
|
||||
| GLPKnown {groupInfo :: GroupInfo}
|
||||
| GLPKnown {groupInfo :: GroupInfo, groupUpdated :: Bool, ownerVerification :: Maybe OwnerVerification}
|
||||
| GLPNoRelays {groupSLinkData_ :: Maybe GroupShortLinkData}
|
||||
deriving (Show)
|
||||
|
||||
@@ -1046,6 +1046,12 @@ data OwnerVerification
|
||||
| OVFailed {reason :: Text}
|
||||
deriving (Show)
|
||||
|
||||
data GroupOwnerContact = GroupOwnerContact
|
||||
{ contactId :: ContactId,
|
||||
memberId :: MemberId
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
type DirectLink = Bool
|
||||
|
||||
data GroupShortLinkInfo = GroupShortLinkInfo
|
||||
|
||||
@@ -1978,9 +1978,9 @@ processChatCommand vr nm = \case
|
||||
createDirectConnection db newUser agConnId ccLink' Nothing ConnNew Nothing subMode initialChatVersion PQSupportOn
|
||||
deleteAgentConnectionAsync (aConnId' conn)
|
||||
pure conn'
|
||||
APIConnectPlan userId (Just cLink) linkOwnerSig_ -> withUserId userId $ \user ->
|
||||
uncurry (CRConnectionPlan user) <$> connectPlan user cLink linkOwnerSig_
|
||||
APIConnectPlan _ Nothing _ -> throwChatError CEInvalidConnReq
|
||||
APIConnectPlan userId (Just cLink) resolveKnown linkOwnerSig_ -> withUserId userId $ \user ->
|
||||
uncurry (CRConnectionPlan user) <$> connectPlan user cLink resolveKnown linkOwnerSig_
|
||||
APIConnectPlan _ Nothing _ _ -> throwChatError CEInvalidConnReq
|
||||
APIPrepareContact userId accLink contactSLinkData -> withUserId userId $ \user -> do
|
||||
let ContactShortLinkData {profile, message, business} = contactSLinkData
|
||||
welcomeSharedMsgId <- forM message $ \_ -> getSharedMsgId
|
||||
@@ -2100,7 +2100,7 @@ processChatCommand vr nm = \case
|
||||
toView $ CEvtNewChatItems user [ci]
|
||||
pure $ CRStartedConnectionToContact user ct' customUserProfile
|
||||
CVRConnectedContact ct' -> pure $ CRContactAlreadyExists user ct'
|
||||
APIConnectPreparedGroup groupId incognito msgContent_ -> withUser $ \user -> do
|
||||
APIConnectPreparedGroup {groupId, incognito, ownerContact, msgContent_} -> withUser $ \user -> do
|
||||
gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
|
||||
case gInfo of
|
||||
GroupInfo {preparedGroup = Nothing} -> throwCmdError "group doesn't have link to connect"
|
||||
@@ -2126,8 +2126,12 @@ processChatCommand vr nm = \case
|
||||
gInfo' <- withFastStore $ \db -> do
|
||||
gInfo' <- updatePreparedRelayedGroup db vr user gInfo mainCReq cReqHash incognitoProfile rootKey memberPrivKey publicMemberCount_
|
||||
-- Pre-emptively create owner members with trusted keys from link data
|
||||
forM_ owners $ \OwnerAuth {ownerId, ownerKey} ->
|
||||
void $ createLinkOwnerMember db vr user gInfo' (MemberId ownerId) ownerKey
|
||||
forM_ owners $ \OwnerAuth {ownerId, ownerKey} -> do
|
||||
let ctId_ = case ownerContact of
|
||||
Just GroupOwnerContact {contactId, memberId}
|
||||
| memberId == MemberId ownerId -> Just contactId
|
||||
_ -> Nothing
|
||||
void $ createLinkOwnerMember db vr user gInfo' ctId_ (MemberId ownerId) ownerKey
|
||||
pure gInfo'
|
||||
rs <- mapConcurrently (connectToRelay gInfo') relays
|
||||
let relayFailed = \case (_, _, Left _) -> True; _ -> False
|
||||
@@ -2221,7 +2225,7 @@ processChatCommand vr nm = \case
|
||||
Connect incognito (Just cLink@(ACL m cLink')) -> withUser $ \user -> do
|
||||
-- TODO [relays] member: /c api to support groups with relays
|
||||
-- TODO - possibly by going through APIPrepareGroup -> APIConnectPreparedGroup
|
||||
(ccLink, plan) <- connectPlan user cLink Nothing `catchAllErrors` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing Nothing)); _ -> throwError e
|
||||
(ccLink, plan) <- connectPlan user cLink False Nothing `catchAllErrors` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing Nothing)); _ -> throwError e
|
||||
connectWithPlan user incognito ccLink plan
|
||||
Connect _ Nothing -> throwChatError CEInvalidConnReq
|
||||
APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do
|
||||
@@ -3978,8 +3982,8 @@ processChatCommand vr nm = \case
|
||||
pure (gId, chatSettings)
|
||||
_ -> throwCmdError "not supported"
|
||||
processChatCommand vr nm $ APISetChatSettings (ChatRef cType chatId Nothing) $ updateSettings chatSettings
|
||||
connectPlan :: User -> AConnectionLink -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan)
|
||||
connectPlan user (ACL SCMInvitation cLink) sig_ = case cLink of
|
||||
connectPlan :: User -> AConnectionLink -> Bool -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan)
|
||||
connectPlan user (ACL SCMInvitation cLink) _ sig_ = case cLink of
|
||||
CLFull cReq -> invitationReqAndPlan cReq Nothing Nothing Nothing
|
||||
CLShort l -> do
|
||||
let l' = serverShortLink l
|
||||
@@ -4000,7 +4004,7 @@ processChatCommand vr nm = \case
|
||||
invitationReqAndPlan cReq sLnk_ cld ov = do
|
||||
plan <- invitationRequestPlan user cReq cld ov `catchAllErrors` (pure . CPError)
|
||||
pure (ACCL SCMInvitation (CCLink cReq sLnk_), plan)
|
||||
connectPlan user (ACL SCMContact cLink) sig_ = case cLink of
|
||||
connectPlan user (ACL SCMContact cLink) resolveKnown sig_ = case cLink of
|
||||
CLFull cReq -> do
|
||||
plan <- contactOrGroupRequestPlan user cReq `catchAllErrors` (pure . CPError)
|
||||
pure (ACCL SCMContact $ CCLink cReq Nothing, plan)
|
||||
@@ -4033,9 +4037,11 @@ processChatCommand vr nm = \case
|
||||
where
|
||||
l' = serverShortLink l
|
||||
con cReq = ACCL SCMContact $ CCLink cReq (Just l')
|
||||
gPlan (cReq, g) = if memberRemoved (membership g) then Nothing else Just (con cReq, CPGroupLink (GLPKnown g))
|
||||
gPlan (cReq, g) = if memberRemoved (membership g) then Nothing else Just (con cReq, CPGroupLink (GLPKnown g False Nothing))
|
||||
groupShortLinkPlan =
|
||||
knownLinkPlans >>= \case
|
||||
Just (_, CPGroupLink (GLPKnown g _ _))
|
||||
| resolveKnown -> resolveKnownGroup g
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
(fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays})) <- getShortLinkConnReq' nm user l'
|
||||
@@ -4045,8 +4051,6 @@ processChatCommand vr nm = \case
|
||||
else do
|
||||
let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd
|
||||
linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId}
|
||||
-- Cross-validate linkEntityId and publicGroupId from profile:
|
||||
-- for channels both must be present and match, for p2p groups both must be absent
|
||||
let profilePGId = groupSLinkData_ >>= \GroupShortLinkData {groupProfile = GroupProfile {publicGroup}} ->
|
||||
fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId) publicGroup
|
||||
case (B64UrlByteString <$> linkEntityId, profilePGId) of
|
||||
@@ -4061,6 +4065,15 @@ processChatCommand vr nm = \case
|
||||
liftIO (getGroupInfoViaUserShortLink db vr user l') >>= \case
|
||||
Just (cReq, g) -> pure $ Just (con cReq, CPGroupLink (GLPOwnLink g))
|
||||
Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db vr user l'
|
||||
resolveKnownGroup g@GroupInfo {groupProfile = p} = do
|
||||
(fd@FixedLinkData {rootKey = rk}, cData@(ContactLinkData _ UserContactData {owners})) <- getShortLinkConnReq' nm user l'
|
||||
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
let ov = verifyLinkOwner rk owners l' sig_
|
||||
(g', updated) <- case groupSLinkData_ of
|
||||
Just GroupShortLinkData {groupProfile}
|
||||
| p /= groupProfile -> (,True) <$> withStore (\db -> updateGroupProfile db user g groupProfile)
|
||||
_ -> pure (g, False)
|
||||
pure (con (linkConnReq fd), CPGroupLink (GLPKnown g' updated ov))
|
||||
connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse
|
||||
connectWithPlan user@User {userId} incognito ccLink plan
|
||||
| connectionPlanProceed plan = do
|
||||
@@ -4140,10 +4153,10 @@ processChatCommand vr nm = \case
|
||||
(Just gInfo, _) -> groupPlan gInfo linkInfo gld ov
|
||||
groupPlan :: GroupInfo -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
|
||||
groupPlan gInfo@GroupInfo {membership} linkInfo gld ov
|
||||
| memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo)
|
||||
| memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo False ov)
|
||||
| not (memberActive membership) && not (memberRemoved membership) =
|
||||
pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo)
|
||||
| memberActive membership = pure $ CPGroupLink (GLPKnown gInfo)
|
||||
| memberActive membership = pure $ CPGroupLink (GLPKnown gInfo False ov)
|
||||
| otherwise = pure $ CPGroupLink (GLPOk linkInfo gld ov)
|
||||
contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact)
|
||||
contactCReqSchemas crData =
|
||||
@@ -5051,13 +5064,13 @@ chatCommandP =
|
||||
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayNameP <* A.space <* char_ '@' <*> (Just <$> displayNameP) <* A.space <*> quotedMsg <*> msgTextP),
|
||||
"/_contacts " *> (APIListContacts <$> A.decimal),
|
||||
"/contacts" $> ListContacts,
|
||||
"/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing) <*> optional (" sig=" *> jsonP)),
|
||||
"/_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),
|
||||
"/_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)),
|
||||
"/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)),
|
||||
"/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> ownerContactP) <*> optional (A.space *> msgContentP)),
|
||||
"/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP),
|
||||
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> connLinkP_),
|
||||
"/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),
|
||||
@@ -5187,6 +5200,7 @@ chatCommandP =
|
||||
((Just <$> connLinkP) <|> A.takeTill (== ' ') $> Nothing)
|
||||
incognitoP = (A.space *> ("incognito" <|> "i")) $> True <|> pure False
|
||||
incognitoOnOffP = (A.space *> "incognito=" *> onOffP) <|> pure False
|
||||
ownerContactP = "contact=" *> (GroupOwnerContact <$> A.decimal <* " owner=" <*> strP)
|
||||
imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,")
|
||||
imageP = safeDecodeUtf8 <$> ((<>) <$> imagePrefix <*> (B64.encode <$> base64P))
|
||||
chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char '*' $> CTLocal <|> A.char ':' $> CTContactConnection
|
||||
|
||||
@@ -2917,8 +2917,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
GCHostMember ->
|
||||
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
|
||||
Right existingMember
|
||||
| useRelays' gInfo ->
|
||||
void $ withStore $ \db -> updatePreparedChannelMember db vr user existingMember memInfo
|
||||
| useRelays' gInfo -> do
|
||||
updatedMember <- withStore $ \db -> updatePreparedChannelMember db vr user existingMember memInfo
|
||||
toView $ CEvtGroupMemberUpdated user gInfo existingMember updatedMember
|
||||
| otherwise ->
|
||||
messageError "x.grp.mem.intro ignored: member already exists"
|
||||
Left _
|
||||
|
||||
@@ -2966,8 +2966,8 @@ createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {g
|
||||
where
|
||||
VersionRange minV maxV = vr
|
||||
|
||||
createLinkOwnerMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> C.PublicKeyEd25519 -> ExceptT StoreError IO GroupMember
|
||||
createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId} memberId ownerKey = do
|
||||
createLinkOwnerMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe ContactId -> MemberId -> C.PublicKeyEd25519 -> ExceptT StoreError IO GroupMember
|
||||
createLinkOwnerMember db vr 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
|
||||
@@ -2983,7 +2983,7 @@ createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, indexInGroup, memberId, GROwner, GCPreMember, GSMemUnknown, Binary B.empty, fromInvitedBy userContactId IBUnknown)
|
||||
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, ownerKey, currentTs, currentTs)
|
||||
:. (userId, localDisplayName, contactId_, profileId, ownerKey, currentTs, currentTs)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
groupMemberId <- liftIO $ insertedRowId db
|
||||
|
||||
@@ -769,15 +769,18 @@ fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contact
|
||||
|
||||
data GroupType
|
||||
= GTChannel
|
||||
| GTGroup
|
||||
| GTUnknown Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance TextEncoding GroupType where
|
||||
textEncode = \case
|
||||
GTChannel -> "channel"
|
||||
GTGroup -> "group"
|
||||
GTUnknown tag -> tag
|
||||
textDecode s = Just $ case s of
|
||||
"channel" -> GTChannel
|
||||
"group" -> GTGroup
|
||||
tag -> GTUnknown tag
|
||||
|
||||
instance FromField GroupType where fromField = fromTextField_ textDecode
|
||||
|
||||
@@ -2103,7 +2103,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
|
||||
GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
|
||||
GLPConnectingProhibit Nothing -> [grpLink "connecting"]
|
||||
GLPConnectingProhibit (Just g) -> connecting g
|
||||
GLPKnown g@GroupInfo {preparedGroup, membership = m} -> case preparedGroup of
|
||||
GLPKnown g@GroupInfo {preparedGroup, membership = m} _ _ -> case preparedGroup of
|
||||
Just PreparedGroup {connLinkStartedConnection} -> case memberStatus m of
|
||||
GSMemUnknown
|
||||
| connLinkStartedConnection -> connecting g
|
||||
|
||||
Reference in New Issue
Block a user