bots: support maintenance option (#6558)

* bots: support maintenance option

* maintenance mode: run pre-start hook, do not create user

apps/simplex-broadcast-bot/src/Broadcast/Options.hs

@@ -94,6 +94,5 @@ mkChatOpts BroadcastBotOpts {coreOptions, botDisplayName} =
       autoAcceptFileSize = 0,
       muteNotifications = True,
       markRead = False,
-      createBot = Just CreateBotOpts {botDisplayName, allowFiles = False},
-      maintenance = False
+      createBot = Just CreateBotOpts {botDisplayName, allowFiles = False}
     }

apps/simplex-directory-service/src/Directory/Options.hs

@@ -27,6 +27,7 @@ data DirectoryOpts = DirectoryOpts
     adminUsers :: [KnownContact],
     superUsers :: [KnownContact],
     ownersGroup :: Maybe KnownGroup,
+    noAddress :: Bool, -- skip creating address
     blockedWordsFile :: Maybe FilePath,
     blockedFragmentsFile :: Maybe FilePath,
     blockedExtensionRules :: Maybe FilePath,
@@ -70,6 +71,11 @@ directoryOpts appDir defaultDbName = do
             <> metavar "OWNERS_GROUP"
             <> help "The group of group owners in the format GROUP_ID:DISPLAY_NAME - owners of listed groups will be invited automatically"
         )
+  noAddress <-
+    switch
+      ( long "no-address"
+          <> help "skip checking and creating service address"
+      )
   blockedWordsFile <-
     optional $
       strOption
@@ -153,6 +159,7 @@ directoryOpts appDir defaultDbName = do
         adminUsers,
         superUsers,
         ownersGroup,
+        noAddress,
         blockedWordsFile,
         blockedFragmentsFile,
         blockedExtensionRules,
@@ -194,8 +201,7 @@ mkChatOpts DirectoryOpts {coreOptions, serviceName} =
       autoAcceptFileSize = 0,
       muteNotifications = True,
       markRead = False,
-      createBot = Just CreateBotOpts {botDisplayName = serviceName, allowFiles = False},
-      maintenance = False
+      createBot = Just CreateBotOpts {botDisplayName = serviceName, allowFiles = False}
     }
 
 parseMigrateLog :: ReadM MigrateLog

apps/simplex-directory-service/src/Directory/Service.hs

@@ -184,10 +184,11 @@ directoryPreStartHook :: DirectoryOpts -> ChatController -> IO ()
 directoryPreStartHook opts ChatController {config, chatStore} = runDirectoryMigrations opts config chatStore
 
 directoryPostStartHook :: DirectoryOpts -> ServiceState -> ChatController -> IO ()
-directoryPostStartHook opts env cc =
+directoryPostStartHook opts@DirectoryOpts {noAddress, testing} env cc =
   readTVarIO (currentUser cc) >>= \case
     Nothing -> putStrLn "No current user" >> exitFailure
     Just User {userId, profile = p@LocalProfile {preferences}} -> do
+      unless noAddress $ initializeBotAddress' (not testing) cc
       listingsUpdated env cc
       let cmds = fromMaybe [] $ preferences >>= commands_
       unless (cmds == directoryCommands) $ do
@@ -216,7 +217,7 @@ directoryCommands =
     idParam = Just "<ID>"
 
 directoryService :: DirectoryLog -> DirectoryOpts -> ChatConfig -> IO ()
-directoryService st opts@DirectoryOpts {testing} cfg = do
+directoryService st opts cfg = do
   env <- newServiceState opts
   let chatHooks =
         defaultChatHooks
@@ -224,8 +225,7 @@ directoryService st opts@DirectoryOpts {testing} cfg = do
             postStartHook = Just $ directoryPostStartHook opts env,
             acceptMember = Just $ acceptMemberHook opts env
           }
-  simplexChatCore cfg {chatHooks} (mkChatOpts opts) $ \user cc -> do
-    initializeBotAddress' (not testing) cc
+  simplexChatCore cfg {chatHooks} (mkChatOpts opts) $ \user cc ->
     raceAny_ $
       [ forever $ void getLine,
         forever $ do

src/Simplex/Chat/Core.hs

@@ -38,7 +38,7 @@ import Text.Read (readMaybe)
 import UnliftIO.Async
 
 simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
-simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@ChatOpts {coreOptions = CoreChatOpts {dbOptions, logAgent, yesToUpMigrations, migrationBackupPath}, createBot, maintenance} chat =
+simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@ChatOpts {coreOptions = CoreChatOpts {dbOptions, logAgent, yesToUpMigrations, migrationBackupPath, maintenance}, createBot} chat =
   case logAgent of
     Just level -> do
       setLogLevel level
@@ -54,13 +54,16 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha
       u_ <- getSelectActiveUser chatStore
       let backgroundMode = maintenance
       cc <- newChatController db u_ cfg opts backgroundMode
-      u <- maybe (createActiveUser cc createBot) pure u_
+      forM_ (preStartHook chatHooks) ($ cc)
+      u <- maybe (noMaintenance >> createActiveUser cc createBot) pure u_
       unless testView $ putStrLn $ "Current user: " <> userStr u
-      unless maintenance $ forM_ (preStartHook chatHooks) ($ cc)
       runSimplexChat opts u cc chat
+    noMaintenance = when maintenance $ do
+      putStrLn "exiting: no active user in maintenance mode"
+      exitFailure
 
 runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
-runSimplexChat ChatOpts {maintenance} u cc@ChatController {config = ChatConfig {chatHooks}} chat
+runSimplexChat ChatOpts {coreOptions = CoreChatOpts {maintenance}} u cc@ChatController {config = ChatConfig {chatHooks}} chat
   | maintenance = wait =<< async (chat u cc)
   | otherwise = do
       a1 <- runReaderT (startChatController True True) cc

src/Simplex/Chat/Mobile.hs

@@ -255,7 +255,8 @@ mobileChatOpts dbOptions =
             deviceName = Nothing,
             highlyAvailable = False,
             yesToUpMigrations = False,
-            migrationBackupPath = Just ""
+            migrationBackupPath = Just "",
+            maintenance = True
           },
       chatCmd = "",
       chatCmdDelay = 3,
@@ -268,8 +269,7 @@ mobileChatOpts dbOptions =
       autoAcceptFileSize = 0,
       muteNotifications = True,
       markRead = False,
-      createBot = Nothing,
-      maintenance = True
+      createBot = Nothing
     }
 
 defaultMobileConfig :: ChatConfig

src/Simplex/Chat/Options.hs

@@ -50,8 +50,7 @@ data ChatOpts = ChatOpts
     autoAcceptFileSize :: Integer,
     muteNotifications :: Bool,
     markRead :: Bool,
-    createBot :: Maybe CreateBotOpts,
-    maintenance :: Bool
+    createBot :: Maybe CreateBotOpts
   }
 
 data CoreChatOpts = CoreChatOpts
@@ -68,7 +67,8 @@ data CoreChatOpts = CoreChatOpts
     deviceName :: Maybe Text,
     highlyAvailable :: Bool,
     yesToUpMigrations :: Bool,
-    migrationBackupPath :: Maybe FilePath
+    migrationBackupPath :: Maybe FilePath,
+    maintenance :: Bool    
   }
 
 data CreateBotOpts = CreateBotOpts
@@ -245,6 +245,12 @@ coreChatOptsP appDir defaultDbName = do
           <> help "Automatically confirm \"up\" database migrations"
       )
   migrationBackupPath <- migrationBackupPathP
+  maintenance <-
+    switch
+      ( long "maintenance"
+          <> short 'm'
+          <> help "Run in maintenance mode (/_start to start chat)"
+      )
   pure
     CoreChatOpts
       { dbOptions,
@@ -271,7 +277,8 @@ coreChatOptsP appDir defaultDbName = do
         deviceName,
         highlyAvailable,
         yesToUpMigrations,
-        migrationBackupPath
+        migrationBackupPath,
+        maintenance
       }
   where
     useTcpTimeout p t = 1000000 * if t > 0 then t else maybe 7 (const 15) p
@@ -376,12 +383,6 @@ chatOptsP appDir defaultDbName = do
       ( long "create-bot-allow-files"
           <> help "Flag for created bot to allow files (only allowed together with --create-bot option)"
       )
-  maintenance <-
-    switch
-      ( long "maintenance"
-          <> short 'm'
-          <> help "Run in maintenance mode (/_start to start chat)"
-      )
   pure
     ChatOpts
       { coreOptions,
@@ -400,8 +401,7 @@ chatOptsP appDir defaultDbName = do
           Just botDisplayName -> Just CreateBotOpts {botDisplayName, allowFiles = createBotAllowFiles}
           Nothing
             | createBotAllowFiles -> error "--create-bot-allow-files option requires --create-bot-name option"
-            | otherwise -> Nothing,
-        maintenance
+            | otherwise -> Nothing
       }
 
 parseProtocolServers :: ProtocolTypeI p => ReadM [ProtoServerWithAuth p]

tests/ChatClient.hs

@@ -117,8 +117,7 @@ testOpts =
       autoAcceptFileSize = 0,
       muteNotifications = True,
       markRead = True,
-      createBot = Nothing,
-      maintenance = False
+      createBot = Nothing
     }
 
 testCoreOpts :: CoreChatOpts
@@ -152,7 +151,8 @@ testCoreOpts =
       deviceName = Nothing,
       highlyAvailable = False,
       yesToUpMigrations = False,
-      migrationBackupPath = Nothing
+      migrationBackupPath = Nothing,
+      maintenance = False      
     }
 
 #if !defined(dbPostgres)
@@ -303,7 +303,7 @@ insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) V
 #endif
 
 startTestChat_ :: TestParams -> ChatDatabase -> ChatConfig -> ChatOpts -> User -> IO TestCC
-startTestChat_ TestParams {printOutput} db cfg opts@ChatOpts {maintenance} user = do
+startTestChat_ TestParams {printOutput} db cfg opts@ChatOpts {coreOptions = CoreChatOpts {maintenance}} user = do
   t <- withVirtualTerminal termSettings pure
   ct <- newChatTerminal t opts
   cc <- newChatController db (Just user) cfg opts False

tests/ChatTests/Direct.hs

@@ -1352,7 +1352,7 @@ testNegotiateCall =
 testMaintenanceMode :: HasCallStack => TestParams -> IO ()
 testMaintenanceMode ps = do
   withNewTestChat ps "bob" bobProfile $ \bob -> do
-    withNewTestChatOpts ps testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do
+    withNewTestChatOpts ps testOpts {coreOptions = testCoreOpts {maintenance = True}} "alice" aliceProfile $ \alice -> do
       alice ##> "/c"
       alice <## "error: chat not started"
       alice ##> "/_start"
@@ -1397,7 +1397,7 @@ testChatWorking alice bob = do
 testMaintenanceModeWithFiles :: HasCallStack => TestParams -> IO ()
 testMaintenanceModeWithFiles ps = withXFTPServer $ do
   withNewTestChat ps "bob" bobProfile $ \bob -> do
-    withNewTestChatOpts ps testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do
+    withNewTestChatOpts ps testOpts {coreOptions = testCoreOpts {maintenance = True}} "alice" aliceProfile $ \alice -> do
       alice ##> "/_start"
       alice <## "chat started"
       alice ##> "/_files_folder ./tests/tmp/alice_files"
@@ -1655,7 +1655,7 @@ testSubscribeAppNSE :: HasCallStack => TestParams -> IO ()
 testSubscribeAppNSE ps =
   withNewTestChat ps "bob" bobProfile $ \bob -> do
     withNewTestChat ps "alice" aliceProfile $ \alice -> do
-      withTestChatOpts ps testOpts {maintenance = True} "alice" $ \nseAlice -> do
+      withTestChatOpts ps testOpts {coreOptions = testCoreOpts {maintenance = True}} "alice" $ \nseAlice -> do
         alice ##> "/_app suspend 1"
         alice <## "ok"
         alice <## "chat suspended"