dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-14 23:25:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

directory: option to run service as CLI (#5494)

Browse Source 
* directory: option to run service as CLI

* support muting groups when joining

* fix test
This commit is contained in:
Evgeny
2025-01-09 15:58:47 +00:00
committed by GitHub
parent 5256606f9d
commit c25d0ea224
6 changed files with 70 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
apps/simplex-directory-service/Main.hs
+4 -2
View File
@@ -10,6 +10,8 @@ import Simplex.Chat.Terminal (terminalChatConfig)
main :: IO ()
main = do
opts@DirectoryOpts {directoryLog} <- welcomeGetOpts
opts@DirectoryOpts {directoryLog, runCLI} <- welcomeGetOpts
st <- restoreDirectoryStore directoryLog
simplexChatCore terminalChatConfig (mkChatOpts opts) $ directoryService st opts
if runCLI
then directoryServiceCLI st opts
else simplexChatCore terminalChatConfig (mkChatOpts opts) $ directoryService st opts
apps/simplex-directory-service/src/Directory/Options.hs
+7
View File
@@ -23,6 +23,7 @@ data DirectoryOpts = DirectoryOpts
superUsers :: [KnownContact],
directoryLog :: Maybe FilePath,
serviceName :: T.Text,
runCLI :: Bool,
searchResults :: Int,
testing :: Bool
}
@@ -58,6 +59,11 @@ directoryOpts appDir defaultDbFileName = do
<> help "The display name of the directory service bot, without *'s and spaces (SimpleX-Directory)"
<> value "SimpleX-Directory"
)
runCLI <-
switch
( long "run-cli"
<> help "Run directory service as CLI"
)
pure
DirectoryOpts
{ coreOptions,
@@ -65,6 +71,7 @@ directoryOpts appDir defaultDbFileName = do
superUsers,
directoryLog,
serviceName = T.pack serviceName,
runCLI,
searchResults = 10,
testing = False
}
apps/simplex-directory-service/src/Directory/Service.hs
+47 -26
View File
@@ -9,6 +9,7 @@
module Directory.Service
( welcomeGetOpts,
directoryService,
directoryServiceCLI,
)
where
@@ -36,6 +37,8 @@ import Simplex.Chat.Messages
import Simplex.Chat.Options
import Simplex.Chat.Protocol (MsgContent (..))
import Simplex.Chat.Store.Shared (StoreError (..))
import Simplex.Chat.Terminal (terminalChatConfig)
import Simplex.Chat.Terminal.Main (simplexChatCLI')
import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Chat.View (serializeChatResponse, simplexChatContact, viewContactName, viewGroupName)
@@ -77,33 +80,51 @@ welcomeGetOpts = do
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
pure opts
directoryServiceCLI :: DirectoryStore -> DirectoryOpts -> IO ()
directoryServiceCLI st opts = do
env <- newServiceState
eventQ <- newTQueueIO
let eventHook cc resp = atomically $ resp <$ writeTQueue eventQ (cc, resp)
race_
(simplexChatCLI' terminalChatConfig {chatHooks = defaultChatHooks {eventHook}} (mkChatOpts opts) Nothing)
(processEvents eventQ env)
where
processEvents eventQ env = forever $ do
(cc, resp) <- atomically $ readTQueue eventQ
u_ <- readTVarIO (currentUser cc)
forM_ u_ $ \user -> directoryServiceEvent st opts env user cc resp
directoryService :: DirectoryStore -> DirectoryOpts -> User -> ChatController -> IO ()
directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchResults, testing} user@User {userId} cc = do
directoryService st opts@DirectoryOpts {testing} user cc = do
initializeBotAddress' (not testing) cc
env <- newServiceState
race_ (forever $ void getLine) . forever $ do
(_, _, 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
DEServiceJoinedGroup ctId g owner -> deServiceJoinedGroup ctId g owner
DEGroupUpdated {contactId, fromGroup, toGroup} -> deGroupUpdated contactId fromGroup toGroup
DEContactRoleChanged g ctId role -> deContactRoleChanged g ctId role
DEServiceRoleChanged g role -> deServiceRoleChanged g role
DEContactRemovedFromGroup ctId g -> deContactRemovedFromGroup ctId g
DEContactLeftGroup ctId g -> deContactLeftGroup ctId g
DEServiceRemovedFromGroup g -> deServiceRemovedFromGroup g
DEGroupDeleted _g -> pure ()
DEUnsupportedMessage _ct _ciId -> pure ()
DEItemEditIgnored _ct -> pure ()
DEItemDeleteIgnored _ct -> pure ()
DEContactCommand ct ciId (ADC sUser cmd) -> do
logInfo $ "command received " <> directoryCmdTag cmd
case sUser of
SDRUser -> deUserCommand env ct ciId cmd
SDRAdmin -> deAdminCommand ct ciId cmd
SDRSuperUser -> deSuperUserCommand ct ciId cmd
DELogChatResponse r -> logInfo r
directoryServiceEvent st opts env user cc resp
directoryServiceEvent :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> ChatResponse -> IO ()
directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, searchResults} ServiceState {searchRequests} user@User {userId} cc event =
forM_ (crDirectoryEvent event) $ \case
DEContactConnected ct -> deContactConnected ct
DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
DEServiceJoinedGroup ctId g owner -> deServiceJoinedGroup ctId g owner
DEGroupUpdated {contactId, fromGroup, toGroup} -> deGroupUpdated contactId fromGroup toGroup
DEContactRoleChanged g ctId role -> deContactRoleChanged g ctId role
DEServiceRoleChanged g role -> deServiceRoleChanged g role
DEContactRemovedFromGroup ctId g -> deContactRemovedFromGroup ctId g
DEContactLeftGroup ctId g -> deContactLeftGroup ctId g
DEServiceRemovedFromGroup g -> deServiceRemovedFromGroup g
DEGroupDeleted _g -> pure ()
DEUnsupportedMessage _ct _ciId -> pure ()
DEItemEditIgnored _ct -> pure ()
DEItemDeleteIgnored _ct -> pure ()
DEContactCommand ct ciId (ADC sUser cmd) -> do
logInfo $ "command received " <> directoryCmdTag cmd
case sUser of
SDRUser -> deUserCommand ct ciId cmd
SDRAdmin -> deAdminCommand ct ciId cmd
SDRSuperUser -> deSuperUserCommand ct ciId cmd
DELogChatResponse r -> logInfo r
where
withAdminUsers action = void . forkIO $ do
forM_ superUsers $ \KnownContact {contactId} -> action contactId
@@ -153,7 +174,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
processInvitation :: Contact -> GroupInfo -> IO ()
processInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = do
void $ addGroupReg st ct g GRSProposed
r <- sendChatCmd cc $ APIJoinGroup groupId
r <- sendChatCmd cc $ APIJoinGroup groupId MFNone
sendMessage cc ct $ case r of
CRUserAcceptedGroupSent {} -> "Joining the group " <> displayName <> "…"
_ -> "Error joining group " <> displayName <> ", please re-send the invitation!"
@@ -417,8 +438,8 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
notifyOwner gr $ serviceName <> " is removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (directory service is removed)."
deUserCommand :: ServiceState -> Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO ()
deUserCommand env@ServiceState {searchRequests} ct ciId = \case
deUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO ()
deUserCommand ct ciId = \case
DCHelp ->
sendMessage cc ct $
"You must be the owner to add the group to the directory:\n\
@@ -446,7 +467,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
STRecent -> withFoundListedGroups Nothing $ sendNextSearchResults takeRecent search
Nothing -> showAllGroups
where
showAllGroups = deUserCommand env ct ciId DCAllGroups
showAllGroups = deUserCommand ct ciId DCAllGroups
DCAllGroups -> withFoundListedGroups Nothing $ sendAllGroups takeTop "top" STAll
DCRecentGroups -> withFoundListedGroups Nothing $ sendAllGroups takeRecent "the most recent" STRecent
DCSubmitGroup _link -> pure ()
src/Simplex/Chat/Controller.hs
+2 -2
View File
@@ -349,7 +349,7 @@ data ChatCommand
| APIGetNtfConns {nonce :: C.CbNonce, encNtfInfo :: ByteString}
| ApiGetConnNtfMessages {connIds :: NonEmpty AgentConnId}
| APIAddMember GroupId ContactId GroupMemberRole
| APIJoinGroup GroupId
| APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter}
| APIMemberRole GroupId GroupMemberId GroupMemberRole
| APIBlockMemberForAll GroupId GroupMemberId Bool
| APIRemoveMember GroupId GroupMemberId
@@ -467,7 +467,7 @@ data ChatCommand
| APINewGroup UserId IncognitoEnabled GroupProfile
| NewGroup IncognitoEnabled GroupProfile
| AddMember GroupName ContactName GroupMemberRole
| JoinGroup GroupName
| JoinGroup {groupName :: GroupName, enableNtfs :: MsgFilter}
| MemberRole GroupName ContactName GroupMemberRole
| BlockForAll GroupName ContactName Bool
| RemoveMember GroupName ContactName
src/Simplex/Chat/Library/Commands.hs
+9 -7
View File
@@ -1924,12 +1924,12 @@ processChatCommand' vr = \case
pure $ CRSentGroupInvitation user gInfo contact member {memberRole = memRole}
Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName
| otherwise -> throwChatError $ CEGroupDuplicateMember cName
APIJoinGroup groupId -> withUser $ \user@User {userId} -> do
APIJoinGroup groupId enableNtfs -> withUser $ \user@User {userId} -> do
withGroupLock "joinGroup" groupId . procCmd $ do
(invitation, ct) <- withFastStore $ \db -> do
inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db vr user groupId
(inv,) <$> getContactViaMember db vr user fromMember
let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} = invitation
let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership, chatSettings}} = invitation
GroupMember {memberId = membershipMemId} = membership
Contact {activeConn} = ct
case activeConn of
@@ -1946,7 +1946,9 @@ processChatCommand' vr = \case
withFastStore' $ \db -> do
updateGroupMemberStatus db userId fromMember GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
void (withAgent $ \a -> joinConnection a (aUserId user) agentConnId True connRequest dm PQSupportOff subMode)
-- MFAll is default for new groups
unless (enableNtfs == MFAll) $ updateGroupSettings db user groupId chatSettings {enableNtfs}
void (withAgent $ \a -> joinConnection a (aUserId user) agentConnId (enableNtfs /= MFNone) connRequest dm PQSupportOff subMode)
`catchChatError` \e -> do
withFastStore' $ \db -> do
updateGroupMemberStatus db userId fromMember GSMemInvited
@@ -2043,9 +2045,9 @@ processChatCommand' vr = \case
AddMember gName cName memRole -> withUser $ \user -> do
(groupId, contactId) <- withFastStore $ \db -> (,) <$> getGroupIdByName db user gName <*> getContactIdByName db user cName
processChatCommand $ APIAddMember groupId contactId memRole
JoinGroup gName -> withUser $ \user -> do
JoinGroup gName enableNtfs -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
processChatCommand $ APIJoinGroup groupId
processChatCommand $ APIJoinGroup groupId enableNtfs
MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMemberRole gId gMemberId memRole
BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMemberForAll gId gMemberId blocked
RemoveMember gName gMemberName -> withMemberName gName gMemberName APIRemoveMember
@@ -3630,7 +3632,7 @@ chatCommandP =
"/_ntf conns " *> (APIGetNtfConns <$> strP <* A.space <*> strP),
"/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP),
"/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
"/_join #" *> (APIJoinGroup <$> A.decimal),
"/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI
"/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
"/_block #" *> (APIBlockMemberForAll <$> A.decimal <* A.space <*> A.decimal <* A.space <* "blocked=" <*> onOffP),
"/_remove #" *> (APIRemoveMember <$> A.decimal <* A.space <*> A.decimal),
@@ -3712,7 +3714,7 @@ chatCommandP =
("/group" <|> "/g") *> (NewGroup <$> incognitoP <* A.space <* char_ '#' <*> groupProfile),
"/_group " *> (APINewGroup <$> A.decimal <*> incognitoOnOffP <* A.space <*> jsonP),
("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> (memberRole <|> pure GRMember)),
("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayName),
("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayName <*> (" mute" $> MFNone <|> pure MFAll)),
("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole),
"/block for all #" *> (BlockForAll <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure True),
"/unblock for all #" *> (BlockForAll <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure False),
tests/Bots/DirectoryTests.hs
+1
View File
@@ -72,6 +72,7 @@ mkDirectoryOpts tmp superUsers =
superUsers,
directoryLog = Just $ tmp </> "directory_service.log",
serviceName = "SimpleX-Directory",
runCLI = False,
searchResults = 3,
testing = True
}