From 6c05eb0ff3616fd44d5ff5d955bdd5f4af920936 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 24 Nov 2023 23:21:38 +0000 Subject: [PATCH] directory: support group names with spaces (#3458) --- .../src/Directory/Events.hs | 12 +++++- .../src/Directory/Service.hs | 4 +- tests/Bots/DirectoryTests.hs | 42 ++++++++++++++----- 3 files changed, 44 insertions(+), 14 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs index dab9ceb77..89231e4db 100644 --- a/apps/simplex-directory-service/src/Directory/Events.hs +++ b/apps/simplex-directory-service/src/Directory/Events.hs @@ -14,6 +14,7 @@ module Directory.Events DirectoryRole (..), SDirectoryRole (..), crDirectoryEvent, + viewName, ) where @@ -158,4 +159,13 @@ directoryCmdP = DCListLastGroups_ -> DCListLastGroups <$> (A.space *> A.decimal <|> pure 10) DCExecuteCommand_ -> DCExecuteCommand . T.unpack <$> (A.space *> A.takeText) where - gc f = f <$> (A.space *> A.decimal <* A.char ':') <*> A.takeTill (== ' ') + gc f = f <$> (A.space *> A.decimal <* A.char ':') <*> displayNameP + displayNameP = quoted '\'' <|> takeNameTill (== ' ') + takeNameTill p = + A.peekChar' >>= \c -> + if refChar c then A.takeTill p else fail "invalid first character in display name" + quoted c = A.char c *> takeNameTill (== c) <* A.char c + refChar c = c > ' ' && c /= '#' && c /= '@' + +viewName :: String -> String +viewName n = if ' ' `elem` n then "'" <> n <> "'" else n diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index a30638249..fb187bbeb 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -156,7 +156,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { askConfirmation = do ugrId <- addGroupReg st ct g GRSPendingConfirmation sendMessage cc ct $ T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already submitted to the directory.\nTo confirm the registration, please send:" - sendMessage cc ct $ "/confirm " <> show ugrId <> ":" <> T.unpack displayName + sendMessage cc ct $ "/confirm " <> show ugrId <> ":" <> viewName (T.unpack displayName) badRolesMsg :: GroupRolesStatus -> Maybe String badRolesMsg = \case @@ -301,7 +301,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { msg = maybe (MCText text) (\image -> MCImage {text, image}) image' withSuperUsers $ \cId -> do sendComposedMessage' cc cId Nothing msg - sendMessage' cc cId $ "/approve " <> show dbGroupId <> ":" <> T.unpack displayName <> " " <> show gaId + sendMessage' cc cId $ "/approve " <> show dbGroupId <> ":" <> viewName (T.unpack displayName) <> " " <> show gaId deContactRoleChanged :: GroupInfo -> ContactId -> GroupMemberRole -> IO () deContactRoleChanged g@GroupInfo {membership = GroupMember {memberRole = serviceRole}} ctId contactRole = diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 36b990ba3..b31d6f36f 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -11,6 +11,7 @@ import ChatTests.Utils import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Exception (finally) import Control.Monad (forM_) +import Directory.Events (viewName) import Directory.Options import Directory.Service import Directory.Store @@ -28,6 +29,7 @@ directoryServiceTests = do it "should register group" testDirectoryService it "should suspend and resume group" testSuspendResume it "should join found group via link" testJoinGroup + it "should support group names with spaces" testGroupNameWithSpaces describe "de-listing the group" $ do it "should de-list if owner leaves the group" testDelistedOwnerLeaves it "should de-list if owner is removed from the group" testDelistedOwnerRemoved @@ -243,6 +245,24 @@ testJoinGroup tmp = cath <## "#privacy: new member dan is connected" ] +testGroupNameWithSpaces :: HasCallStack => FilePath -> IO () +testGroupNameWithSpaces tmp = + withDirectoryService tmp $ \superUser dsLink -> + withNewTestChat tmp "bob" bobProfile $ \bob -> do + bob `connectVia` dsLink + registerGroup superUser bob "Privacy & Security" "" + groupFound bob "Privacy & Security" + superUser #> "@SimpleX-Directory /suspend 1:'Privacy & Security'" + superUser <# "SimpleX-Directory> > /suspend 1:'Privacy & Security'" + superUser <## " Group suspended!" + bob <# "SimpleX-Directory> The group ID 1 (Privacy & Security) is suspended and hidden from directory. Please contact the administrators." + groupNotFound bob "privacy" + superUser #> "@SimpleX-Directory /resume 1:'Privacy & Security'" + superUser <# "SimpleX-Directory> > /resume 1:'Privacy & Security'" + superUser <## " Group listing resumed!" + bob <# "SimpleX-Directory> The group ID 1 (Privacy & Security) is listed in the directory again!" + groupFound bob "Privacy & Security" + testDelistedOwnerLeaves :: HasCallStack => FilePath -> IO () testDelistedOwnerLeaves tmp = withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink -> @@ -840,16 +860,16 @@ registerGroupId su u n fn gId ugId = do submitGroup :: TestCC -> String -> String -> IO () submitGroup u n fn = do - u ##> ("/g " <> n <> " " <> fn) - u <## ("group #" <> n <> " (" <> fn <> ") is created") - u <## ("to add members use /a " <> n <> " or /create link #" <> n) - u ##> ("/a " <> n <> " SimpleX-Directory admin") - u <## ("invitation to join the group #" <> n <> " sent to SimpleX-Directory") + u ##> ("/g " <> viewName n <> if null fn then "" else " " <> fn) + u <## ("group #" <> viewName n <> (if null fn then "" else " (" <> fn <> ")") <> " is created") + u <## ("to add members use /a " <> viewName n <> " or /create link #" <> viewName n) + u ##> ("/a " <> viewName n <> " SimpleX-Directory admin") + u <## ("invitation to join the group #" <> viewName n <> " sent to SimpleX-Directory") groupAccepted :: TestCC -> String -> IO String groupAccepted u n = do u <# ("SimpleX-Directory> Joining the group " <> n <> "…") - u <## ("#" <> n <> ": SimpleX-Directory joined the group") + u <## ("#" <> viewName n <> ": SimpleX-Directory joined the group") u <# ("SimpleX-Directory> Joined the group " <> n <> ", creating the link…") u <# "SimpleX-Directory> Created the public link to join the group via this directory service that is always online." u <## "" @@ -869,7 +889,7 @@ completeRegistrationId su u n fn welcomeWithLink gId ugId = do updateProfileWithLink :: TestCC -> String -> String -> Int -> IO () updateProfileWithLink u n welcomeWithLink ugId = do - u ##> ("/set welcome " <> n <> " " <> welcomeWithLink) + u ##> ("/set welcome " <> viewName n <> " " <> welcomeWithLink) u <## "description changed to:" u <## welcomeWithLink u <# ("SimpleX-Directory> Thank you! The group link for ID " <> show ugId <> " (" <> n <> ") is added to the welcome message.") @@ -879,13 +899,13 @@ notifySuperUser :: TestCC -> TestCC -> String -> String -> String -> Int -> IO ( notifySuperUser su u n fn welcomeWithLink gId = do uName <- userName u su <# ("SimpleX-Directory> " <> uName <> " submitted the group ID " <> show gId <> ":") - su <## (n <> " (" <> fn <> ")") + su <## (n <> if null fn then "" else " (" <> fn <> ")") su <## "Welcome message:" su <## welcomeWithLink su .<## "members" su <## "" su <## "To approve send:" - let approve = "/approve " <> show gId <> ":" <> n <> " 1" + let approve = "/approve " <> show gId <> ":" <> viewName n <> " 1" su <# ("SimpleX-Directory> " <> approve) approveRegistration :: TestCC -> TestCC -> String -> Int -> IO () @@ -894,7 +914,7 @@ approveRegistration su u n gId = approveRegistrationId :: TestCC -> TestCC -> String -> Int -> Int -> IO () approveRegistrationId su u n gId ugId = do - let approve = "/approve " <> show gId <> ":" <> n <> " 1" + let approve = "/approve " <> show gId <> ":" <> viewName n <> " 1" su #> ("@SimpleX-Directory " <> approve) su <# ("SimpleX-Directory> > " <> approve) su <## " Group approved!" @@ -948,7 +968,7 @@ groupFoundN count u name = do u #> ("@SimpleX-Directory " <> name) u <# ("SimpleX-Directory> > " <> name) u <## " Found 1 group(s)" - u <#. ("SimpleX-Directory> " <> name <> " (") + u <#. ("SimpleX-Directory> " <> name) u <## "Welcome message:" u <##. "Link to join the group " u <## (show count <> " members")