From fe652fb56cee391094ba3c67dee7108f35649cf4 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Fri, 1 Aug 2025 16:24:26 +0100 Subject: [PATCH] directory bot: fix group ID for short link upgrade (#6134) * directory bot: fix group ID for short link upgrade * split link to separate message * enable all tests --- .../src/Directory/Service.hs | 44 ++++++++----------- tests/Bots/DirectoryTests.hs | 20 ++++++--- 2 files changed, 34 insertions(+), 30 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index eaf3918170..1cbf419f41 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -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 diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 483736dbbf..6a4ff8f5fc 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -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"