Merge branch 'master' into master-ghc8107

This commit is contained in:
Evgeny Poberezkin
2023-11-20 13:01:22 +00:00
163 changed files with 8027 additions and 2245 deletions
@@ -59,7 +59,7 @@ welcomeGetOpts :: IO DirectoryOpts
welcomeGetOpts = do
appDir <- getAppUserDataDirectory "simplex"
opts@DirectoryOpts {coreOptions = CoreChatOpts {dbFilePrefix}, testing} <- getDirectoryOpts appDir "simplex_directory_service"
unless testing $ do
unless testing $ do
putStrLn $ "SimpleX Directory Service Bot v" ++ versionNumber
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
pure opts
@@ -68,7 +68,7 @@ directoryService :: DirectoryStore -> DirectoryOpts -> User -> ChatController ->
directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {userId} cc = do
initializeBotAddress' (not testing) cc
race_ (forever $ void getLine) . forever $ do
(_, resp) <- atomically . readTBQueue $ outputQ cc
(_, _, resp) <- atomically . readTBQueue $ outputQ cc
forM_ (crDirectoryEvent resp) $ \case
DEContactConnected ct -> deContactConnected ct
DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
@@ -161,7 +161,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {
badRolesMsg :: GroupRolesStatus -> Maybe String
badRolesMsg = \case
GRSOk -> Nothing
GRSServiceNotAdmin -> Just "You must have a group *owner* role to register the group"
GRSServiceNotAdmin -> Just "You must have a group *owner* role to register the group"
GRSContactNotOwner -> Just "You must grant directory service *admin* role to register the group"
GRSBadRoles -> Just "You must have a group *owner* role and you must grant directory service *admin* role to register the group"
@@ -352,7 +352,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {
groupRef = groupReference g
srvRole = "*" <> B.unpack (strEncode serviceRole) <> "*"
suSrvRole = "(" <> serviceName <> " role is changed to " <> srvRole <> ")."
whenContactIsOwner gr action =
whenContactIsOwner gr action =
getGroupMember gr >>=
mapM_ (\cm@GroupMember {memberRole} -> when (memberRole == GROwner && memberActive cm) action)
@@ -494,7 +494,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {
sendChatCmdStr cc cmdStr >>= \r -> do
ts <- getCurrentTime
tz <- getCurrentTimeZone
sendReply $ serializeChatResponse (Just user) ts tz r
sendReply $ serializeChatResponse (Nothing, Just user) ts tz Nothing r
DCCommandError tag -> sendReply $ "Command error: " <> show tag
| otherwise = sendReply "You are not allowed to use this command"
where