diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 246564cbe..5825648a1 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -30,6 +30,7 @@ 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') @@ -245,13 +246,9 @@ cfgServers = \case SPSMP -> smp SPXFTP -> xftp -startChatController :: forall m. ChatMonad' m => ChatCtrlCfg -> m (Async ()) -startChatController ChatCtrlCfg {subConns, enableExpireCIs, startXFTPWorkers, openDBWithKey} = do - ChatController {chatStore, smpAgent} <- ask - forM_ openDBWithKey $ \(DBEncryptionKey dbKey) -> liftIO $ do - openSQLiteStore chatStore dbKey - openSQLiteStore (agentClientStore smpAgent) dbKey - resumeAgentClient smpAgent +startChatController :: forall m. ChatMonad' m => Bool -> Bool -> Bool -> m (Async ()) +startChatController subConns enableExpireCIs startXFTPWorkers = do + resumeAgentClient =<< asks smpAgent unless subConns $ chatWriteVar subscriptionMode SMOnlyCreate users <- fromRight [] <$> runExceptT (withStoreCtx' (Just "startChatController, getUsers") getUsers) @@ -465,10 +462,17 @@ processChatCommand = \case checkDeleteChatUser user' withChatLock "deleteUser" . procCmd $ deleteChatUser user' delSMPQueues DeleteUser uName delSMPQueues viewPwd_ -> withUserName uName $ \userId -> APIDeleteUser userId delSMPQueues viewPwd_ - APIStartChat cfg -> withUser' $ \_ -> + APIStartChat ChatCtrlCfg {subConns, enableExpireCIs, startXFTPWorkers, openDBWithKey} -> withUser' $ \_ -> asks agentAsync >>= readTVarIO >>= \case Just _ -> pure CRChatRunning - _ -> checkStoreNotChanged $ startChatController cfg $> CRChatStarted + _ -> 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) pure CRChatStopped diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs index 6ede07f7d..17b963156 100644 --- a/src/Simplex/Chat/Archive.hs +++ b/src/Simplex/Chat/Archive.hs @@ -9,6 +9,7 @@ module Simplex.Chat.Archive importArchive, deleteStorage, sqlCipherExport, + handleDBError, ) where @@ -138,17 +139,7 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D withDB (`SQL.exec` testSQL) DBErrorOpen atomically $ writeTVar dbEnc $ not (null key') where - 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 + withDB a err = handleDBError err $ bracket (SQL.open $ T.pack f) SQL.close a exportSQL = T.unlines $ keySQL key @@ -165,3 +156,16 @@ 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 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 2931a874e..3f3dae94f 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -629,9 +629,6 @@ data ChatCtrlCfg = ChatCtrlCfg } deriving (Show, Generic, FromJSON) -defChatCtrlCfg :: ChatCtrlCfg -defChatCtrlCfg = ChatCtrlCfg True True True Nothing - newtype UserPwd = UserPwd {unUserPwd :: Text} deriving (Eq, Show) diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index b09413037..4af161ab4 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -35,7 +35,7 @@ runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController runSimplexChat ChatOpts {maintenance} u cc chat | maintenance = wait =<< async (chat u cc) | otherwise = do - a1 <- runReaderT (startChatController defChatCtrlCfg) cc + a1 <- runReaderT (startChatController True True True) cc a2 <- async $ chat u cc waitEither_ a1 a2 diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index f363d020f..18d0a8884 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1642,7 +1642,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 after encryption: " <> sqliteError' e] + DBErrorOpen e -> ["error opening database: " <> sqliteError' e] e -> ["chat database error: " <> sShow e] ChatErrorAgent err entity_ -> case err of CMD PROHIBITED -> [withConnEntity <> "error: command is prohibited"] diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 36e74e11f..d9e8bac2f 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -959,6 +959,8 @@ testDatabaseEncryption tmp = do alice <## "chat stopped" alice ##> "/db key wrongkey nextkey" alice <## "error encrypting database: wrong passphrase or invalid database file" + alice ##> "/_start key=wrongkey" + alice <## "error opening database: wrong passphrase or invalid database file" alice ##> "/_start key=mykey" alice <## "chat started" testChatWorking alice bob