core: revert stop/close changes made for Windows (#3145)

* Revert "core: return error response when wrong passphrase is passed to start"

This reverts commit ea319313f1.

* Revert "core: support closing/re-opening store on chat stop/start (#3132)"

This reverts commit 3c7fc6b0ee.

src/Simplex/Chat.hs

@@ -34,7 +34,6 @@ import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isSpace, toLower)
-import Data.Composition ((.:))
 import Data.Constraint (Dict (..))
 import Data.Either (fromRight, rights)
 import Data.Fixed (div')
@@ -84,7 +83,7 @@ import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentCl
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, SQLiteStore (dbNew), execSQL, upMigration, withConnection, closeSQLiteStore, openSQLiteStore)
+import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, SQLiteStore (dbNew), execSQL, upMigration, withConnection)
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
@@ -218,8 +217,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   where
     configServers :: DefaultAgentServers
     configServers =
-      let smp' = fromMaybe defaultServers.smp (nonEmpty smpServers)
-          xftp' = fromMaybe defaultServers.xftp (nonEmpty xftpServers)
+      let smp' = fromMaybe (defaultServers.smp) (nonEmpty smpServers)
+          xftp' = fromMaybe (defaultServers.xftp) (nonEmpty xftpServers)
        in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig}
     agentServers :: ChatConfig -> IO InitialAgentServers
     agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do
@@ -252,7 +251,7 @@ cfgServers p s = case p of
 
 startChatController :: forall m. ChatMonad' m => Bool -> Bool -> Bool -> m (Async ())
 startChatController subConns enableExpireCIs startXFTPWorkers = do
-  resumeAgentClient =<< asks smpAgent
+  asks smpAgent >>= resumeAgentClient
   unless subConns $
     chatWriteVar subscriptionMode SMOnlyCreate
   users <- fromRight [] <$> runExceptT (withStoreCtx' (Just "startChatController, getUsers") getUsers)
@@ -324,8 +323,8 @@ restoreCalls = do
   calls <- asks currentCalls
   atomically $ writeTVar calls callsMap
 
-stopChatController :: forall m. MonadUnliftIO m => ChatController -> Bool -> m ()
-stopChatController ChatController {chatStore, smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags} closeStore = do
+stopChatController :: forall m. MonadUnliftIO m => ChatController -> m ()
+stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags} = do
   disconnectAgentClient smpAgent
   readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
   closeFiles sndFiles
@@ -334,9 +333,6 @@ stopChatController ChatController {chatStore, smpAgent, agentAsync = s, sndFiles
     keys <- M.keys <$> readTVar expireCIFlags
     forM_ keys $ \k -> TM.insert k False expireCIFlags
     writeTVar s Nothing
-  when closeStore $ liftIO $ do
-    closeSQLiteStore chatStore
-    closeSQLiteStore $ agentClientStore smpAgent
   where
     closeFiles :: TVar (Map Int64 Handle) -> m ()
     closeFiles files = do
@@ -466,19 +462,12 @@ processChatCommand = \case
     checkDeleteChatUser user'
     withChatLock "deleteUser" . procCmd $ deleteChatUser user' delSMPQueues
   DeleteUser uName delSMPQueues viewPwd_ -> withUserName uName $ \userId -> APIDeleteUser userId delSMPQueues viewPwd_
-  APIStartChat ChatCtrlCfg {subConns, enableExpireCIs, startXFTPWorkers, openDBWithKey} -> withUser' $ \_ ->
+  StartChat subConns enableExpireCIs startXFTPWorkers -> withUser' $ \_ ->
     asks agentAsync >>= readTVarIO >>= \case
       Just _ -> pure CRChatRunning
-      _ -> checkStoreNotChanged $ do
-        forM_ openDBWithKey $ \(DBEncryptionKey dbKey) -> do
-          ChatController {chatStore, smpAgent} <- ask
-          open chatStore dbKey
-          open (agentClientStore smpAgent) dbKey
-        startChatController subConns enableExpireCIs startXFTPWorkers $> CRChatStarted
-        where
-          open = handleDBError DBErrorOpen .: openSQLiteStore
-  APIStopChat closeStore -> do
-    ask >>= (`stopChatController` closeStore)
+      _ -> checkStoreNotChanged $ startChatController subConns enableExpireCIs startXFTPWorkers $> CRChatStarted
+  APIStopChat -> do
+    ask >>= stopChatController
     pure CRChatStopped
   APIActivateChat -> withUser $ \_ -> do
     restoreCalls
@@ -5411,9 +5400,9 @@ chatCommandP =
       "/_delete user " *> (APIDeleteUser <$> A.decimal <* " del_smp=" <*> onOffP <*> optional (A.space *> jsonP)),
       "/delete user " *> (DeleteUser <$> displayName <*> pure True <*> optional (A.space *> pwdP)),
       ("/user" <|> "/u") $> ShowActiveUser,
-      "/_start" *> (APIStartChat <$> ((A.space *> jsonP) <|> chatCtrlCfgP)),
-      "/_stop close" $> APIStopChat {closeStore = True},
-      "/_stop" $> APIStopChat False,
+      "/_start subscribe=" *> (StartChat <$> onOffP <* " expire=" <*> onOffP <* " xftp=" <*> onOffP),
+      "/_start" $> StartChat True True True,
+      "/_stop" $> APIStopChat,
       "/_app activate" $> APIActivateChat,
       "/_app suspend " *> (APISuspendChat <$> A.decimal),
       "/_resubscribe all" $> ResubscribeAllConnections,
@@ -5641,12 +5630,6 @@ chatCommandP =
     ]
   where
     choice = A.choice . map (\p -> p <* A.takeWhile (== ' ') <* A.endOfInput)
-    chatCtrlCfgP = do
-      subConns <- (" subscribe=" *> onOffP) <|> pure True
-      enableExpireCIs <- (" expire=" *> onOffP) <|> pure True
-      startXFTPWorkers <- (" xftp=" *> onOffP) <|> pure True
-      openDBWithKey <- optional $ " key=" *> dbKeyP
-      pure ChatCtrlCfg {subConns, enableExpireCIs, startXFTPWorkers, openDBWithKey}
     incognitoP = (A.space *> ("incognito" <|> "i")) $> True <|> pure False
     incognitoOnOffP = (A.space *> "incognito=" *> onOffP) <|> pure False
     imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,")

src/Simplex/Chat/Archive.hs

@@ -9,7 +9,6 @@ module Simplex.Chat.Archive
     importArchive,
     deleteStorage,
     sqlCipherExport,
-    handleDBError,
   )
 where
 
@@ -125,7 +124,7 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
     checkFile `with` fs
     backup `with` fs
     (export chatDb chatEncrypted >> export agentDb agentEncrypted)
-      `catchChatError` \e -> tryChatError (restore `with` fs) >> throwError e
+      `catchChatError` \e -> (restore `with` fs) >> throwError e
   where
     action `with` StorageFiles {chatDb, agentDb} = action chatDb >> action agentDb
     backup f = copyFile f (f <> ".bak")
@@ -140,7 +139,17 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
       withDB (`SQL.exec` testSQL) DBErrorOpen
       atomically $ writeTVar dbEnc $ not (null key')
       where
-        withDB a err = handleDBError err $ bracket (SQL.open $ T.pack f) SQL.close a
+        withDB a err =
+          liftIO (bracket (SQL.open $ T.pack f) SQL.close a $> Nothing)
+            `catch` checkSQLError
+            `catch` (\(e :: SomeException) -> sqliteError' e)
+            >>= mapM_ (throwDBError . err)
+          where
+            checkSQLError e = case SQL.sqlError e of
+              SQL.ErrorNotADatabase -> pure $ Just SQLiteErrorNotADatabase
+              _ -> sqliteError' e
+            sqliteError' :: Show e => e -> m (Maybe SQLiteError)
+            sqliteError' = pure . Just . SQLiteError . show
         exportSQL =
           T.unlines $
             keySQL key
@@ -157,16 +166,3 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
                    "SELECT count(*) FROM sqlite_master;"
                  ]
         keySQL k = ["PRAGMA key = " <> sqlString k <> ";" | not (null k)]
-
-handleDBError :: forall m. ChatMonad m => (SQLiteError -> DatabaseError) -> IO () -> m ()
-handleDBError err a =
-  (liftIO a $> Nothing)
-    `catch` checkSQLError
-    `catch` (\(e :: SomeException) -> sqliteError' e)
-    >>= mapM_ (throwDBError . err)
-  where
-    checkSQLError e = case SQL.sqlError e of
-      SQL.ErrorNotADatabase -> pure $ Just SQLiteErrorNotADatabase
-      _ -> sqliteError' e
-    sqliteError' :: Show e => e -> m (Maybe SQLiteError)
-    sqliteError' = pure . Just . SQLiteError . show

src/Simplex/Chat/Controller.hs

@@ -221,8 +221,8 @@ data ChatCommand
   | UnmuteUser
   | APIDeleteUser UserId Bool (Maybe UserPwd)
   | DeleteUser UserName Bool (Maybe UserPwd)
-  | APIStartChat ChatCtrlCfg
-  | APIStopChat {closeStore :: Bool}
+  | StartChat {subscribeConnections :: Bool, enableExpireChatItems :: Bool, startXFTPWorkers :: Bool}
+  | APIStopChat
   | APIActivateChat
   | APISuspendChat {suspendTimeout :: Int}
   | ResubscribeAllConnections
@@ -621,14 +621,6 @@ instance ToJSON ChatResponse where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
 
-data ChatCtrlCfg = ChatCtrlCfg
-  { subConns :: Bool,
-    enableExpireCIs :: Bool,
-    startXFTPWorkers :: Bool,
-    openDBWithKey :: Maybe DBEncryptionKey
-  }
-  deriving (Show, Generic, FromJSON)
-
 newtype UserPwd = UserPwd {unUserPwd :: Text}
   deriving (Eq, Show)
 

src/Simplex/Chat/View.hs

@@ -1648,7 +1648,7 @@ viewChatError logLevel = \case
     DBErrorEncrypted -> ["error: chat database is already encrypted"]
     DBErrorPlaintext -> ["error: chat database is not encrypted"]
     DBErrorExport e -> ["error encrypting database: " <> sqliteError' e]
-    DBErrorOpen e -> ["error opening database: " <> sqliteError' e]
+    DBErrorOpen e -> ["error opening database after encryption: " <> sqliteError' e]
     e -> ["chat database error: " <> sShow e]
   ChatErrorAgent err entity_ -> case err of
     CMD PROHIBITED -> [withConnEntity <> "error: command is prohibited"]