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

directory bot: fix group ID for short link upgrade (#6134)

Browse Source 
* directory bot: fix group ID for short link upgrade

* split link to separate message

* enable all tests
This commit is contained in:
Evgeny
2025-08-01 16:24:26 +01:00
committed by GitHub
parent 18a00511a7
commit fe652fb56c
2 changed files with 34 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
apps/simplex-directory-service/src/Directory/Service.hs
View File

@@ -780,9 +780,9 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
Just PCAll -> "_enabled_"
Just PCNoImage -> "_enabled for profiles without image_"
DCShowUpgradeGroupLink gId gName_ ->
(if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \GroupInfo {localDisplayName = gName} _ -> do
(if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \GroupInfo {groupId, localDisplayName = gName} _ -> do
let groupRef = groupReference' gId gName
withGroupLinkResult groupRef (sendChatCmd cc $ APIGetGroupLink gId) $
withGroupLinkResult groupRef (sendChatCmd cc $ APIGetGroupLink groupId) $
\GroupLink {connLinkContact = gLink@(CCLink _ sLnk_), acceptMemberRole, shortLinkDataSet, shortLinkLargeDataSet = BoolDef slLargeDataSet} -> do
let shouldBeUpgraded = isNothing sLnk_ || not shortLinkDataSet || not slLargeDataSet
sendReply $ T.unlines $
@@ -792,29 +792,23 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
]
<> ["The link is being upgraded..." | shouldBeUpgraded]
when shouldBeUpgraded $ do
withGroupLinkResult groupRef (sendChatCmd cc $ APIAddGroupShortLink gId) $
\GroupLink {connLinkContact = CCLink _ sLnk_'} ->
sendComposedMessage cc ct Nothing $ MCText $ T.unlines $
case (sLnk_, sLnk_') of
(Just _, Just _) -> ["The group link is upgraded for: " <> groupRef, "No changes to group needed."]
(Nothing, Just sLnk) ->
[ "Please replace the old link in welcome message of your group " <> groupRef <> " with this link:",
strEncodeTxt sLnk,
"",
"If this is the only change, the group will remain listed in directory without re-approval."
]
(_, Nothing) ->
["The short link is not created for " <> groupRef, "Please report it to the developers."]
-- Left (ChatErrorStore (SEGroupLinkNotFound _)) ->
-- sendReply $ "The group " <> groupRef <> " has no public link."
-- Right r -> do
-- ts <- getCurrentTime
-- tz <- getCurrentTimeZone
-- let resp = T.pack $ serializeChatResponse (Nothing, Just user) (config cc) ts tz Nothing r
-- sendReply $ "Unexpected error:\n" <> resp
-- Left e -> do
-- let resp = T.pack $ serializeChatError True (config cc) e
-- sendReply $ "Unexpected error:\n" <> resp
let send = sendComposedMessage cc ct Nothing . MCText . T.unlines
withGroupLinkResult groupRef (sendChatCmd cc $ APIAddGroupShortLink groupId) $
\GroupLink {connLinkContact = CCLink _ sLnk_'} -> case (sLnk_, sLnk_') of
(Just _, Just _) ->
send ["The group link is upgraded for: " <> groupRef, "No changes to group needed."]
(Nothing, Just sLnk) ->
sendComposedMessages cc (SRDirect $ contactId' ct)
[ MCText $ T.unlines
[ "Please replace the old link in welcome message of your group " <> groupRef,
"If this is the only change, the group will remain listed in directory without re-approval.",
"",
"The new link:"
],
MCText $ strEncodeTxt sLnk
]
(_, Nothing) ->
send ["The short link is not created for " <> groupRef, "Please report it to the developers."]
where
withGroupLinkResult groupRef a cb =
a >>= \case

20
tests/Bots/DirectoryTests.hs
View File

@@ -274,17 +274,27 @@ testSuspendResume ps =
superUser <## "The group remained listed in directory."
-- upgrade link
-- make it upgradeable first
superUser #> "@SimpleX-Directory /x /sql chat UPDATE user_contact_links SET short_link_data_set = 0"
superUser <# "SimpleX-Directory> > /x /sql chat UPDATE user_contact_links SET short_link_data_set = 0"
superUser #> "@SimpleX-Directory /x /sql chat UPDATE user_contact_links SET short_link_contact = NULL"
superUser <# "SimpleX-Directory> > /x /sql chat UPDATE user_contact_links SET short_link_contact = NULL"
superUser <## ""
bob #> "@SimpleX-Directory /link 1"
bob <# "SimpleX-Directory> > /link 1"
bob <## " The link to join the group ID 1 (privacy):"
bob <##. "https://localhost/g#"
bob <##. "https://simplex.chat/contact#/"
bob <## "New member role: member"
bob <## "The link is being upgraded..."
bob <# "SimpleX-Directory> The group link is upgraded for: ID 1 (privacy)"
bob <## "No changes to group needed."
bob <# "SimpleX-Directory> Please replace the old link in welcome message of your group ID 1 (privacy)"
bob <## "If this is the only change, the group will remain listed in directory without re-approval."
bob <## ""
bob <## "The new link:"
gLink' <- dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine bob
bob ##> ("/set welcome #privacy Link to join the group privacy: " <> gLink')
bob <## "welcome message changed to:"
bob <## ("Link to join the group privacy: " <> gLink')
bob <# "SimpleX-Directory> The group ID 1 (privacy) is updated!"
bob <## "The group is listed in directory."
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is updated - only link or whitespace changes."
superUser <## "The group remained listed in directory."
-- send message to group owner
superUser #> "@SimpleX-Directory /owner 1:privacy hello there"
superUser <# "SimpleX-Directory> > /owner 1:privacy hello there"