Merge branch 'master' into master-ghc8107

2026-04-29 03:55:51 +00:00 · 2023-12-11 14:56:25 +00:00
parent 53560378bb d358390e3d
commit 6546426ec0
35 changed files with 1031 additions and 289 deletions
@@ -8,7 +8,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
@@ -27,6 +26,8 @@ import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -49,7 +50,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
-import Data.Time.Clock.System (SystemTime, systemToUTCTime)
+import Data.Time.Clock.System (systemToUTCTime)
 import Data.Word (Word16, Word32)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Chat.Archive
@@ -190,10 +191,10 @@ smallGroupsRcptsMemLimit = 20
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}

-createChatDatabase :: FilePath -> String -> MigrationConfirmation -> IO (Either MigrationError ChatDatabase)
-createChatDatabase filePrefix key confirmMigrations = runExceptT $ do
-  chatStore <- ExceptT $ createChatStore (chatStoreFile filePrefix) key confirmMigrations
-  agentStore <- ExceptT $ createAgentStore (agentStoreFile filePrefix) key confirmMigrations
+createChatDatabase :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError ChatDatabase)
+createChatDatabase filePrefix key keepKey confirmMigrations = runExceptT $ do
+  chatStore <- ExceptT $ createChatStore (chatStoreFile filePrefix) key keepKey confirmMigrations
+  agentStore <- ExceptT $ createAgentStore (agentStoreFile filePrefix) key keepKey confirmMigrations
  pure ChatDatabase {chatStore, agentStore}

 newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> IO ChatController
@@ -537,16 +538,18 @@ processChatCommand = \case
  APIStopChat -> do
    ask >>= stopChatController
    pure CRChatStopped
-  APIActivateChat -> withUser $ \_ -> do
-    restoreCalls
+  APIActivateChat restoreChat -> withUser $ \_ -> do
+    when restoreChat restoreCalls
    withAgent foregroundAgent
-    users <- withStoreCtx' (Just "APIActivateChat, getUsers") getUsers
-    void . forkIO $ subscribeUsers True users
-    void . forkIO $ startFilesToReceive users
-    setAllExpireCIFlags True
+    when restoreChat $ do
+      users <- withStoreCtx' (Just "APIActivateChat, getUsers") getUsers
+      void . forkIO $ subscribeUsers True users
+      void . forkIO $ startFilesToReceive users
+      setAllExpireCIFlags True
    ok_
  APISuspendChat t -> do
    setAllExpireCIFlags False
+    stopRemoteCtrl
    withAgent (`suspendAgent` t)
    ok_
  ResubscribeAllConnections -> withStoreCtx' (Just "ResubscribeAllConnections, getUsers") getUsers >>= subscribeUsers False >> ok_
@@ -595,7 +598,7 @@ processChatCommand = \case
            . sortOn (timeAvg . snd)
            . M.assocs
            <$> withConnection st (readTVarIO . DB.slow)
-  APIGetChats {userId, pendingConnections, pagination, query} -> withUserId userId $ \user -> do
+  APIGetChats {userId, pendingConnections, pagination, query} -> withUserId' userId $ \user -> do
    (errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user pendingConnections pagination query)
    toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
    pure $ CRApiChats user previews
@@ -1177,16 +1180,13 @@ processChatCommand = \case
  APIDeleteToken token -> withUser $ \_ -> withAgent (`deleteNtfToken` token) >> ok_
  APIGetNtfMessage nonce encNtfInfo -> withUser $ \_ -> do
    (NotificationInfo {ntfConnId, ntfMsgMeta}, msgs) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo
-    let ntfMessages = map (\SMP.SMPMsgMeta {msgTs, msgFlags} -> NtfMsgInfo {msgTs = systemToUTCTime msgTs, msgFlags}) msgs
-        getMsgTs :: SMP.NMsgMeta -> SystemTime
-        getMsgTs SMP.NMsgMeta {msgTs} = msgTs
-        msgTs' = systemToUTCTime . getMsgTs <$> ntfMsgMeta
+    let msgTs' = systemToUTCTime . (\SMP.NMsgMeta {msgTs} -> msgTs) <$> ntfMsgMeta
        agentConnId = AgentConnId ntfConnId
    user_ <- withStore' (`getUserByAConnId` agentConnId)
-    connEntity <-
+    connEntity_ <-
      pure user_ $>>= \user ->
        withStore (\db -> Just <$> getConnectionEntity db user agentConnId) `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
-    pure CRNtfMessages {user_, connEntity, msgTs = msgTs', ntfMessages}
+    pure CRNtfMessages {user_, connEntity_, msgTs = msgTs', ntfMessages = map ntfMsgInfo msgs}
  APIGetUserProtoServers userId (AProtocolType p) -> withUserId userId $ \user -> withServerProtocol p $ do
    ChatConfig {defaultServers} <- asks config
    servers <- withStore' (`getProtocolServers` user)
@@ -1210,8 +1210,7 @@ processChatCommand = \case
      CRServerTestResult user srv <$> withAgent (\a -> testProtocolServer a (aUserId user) server)
  TestProtoServer srv -> withUser $ \User {userId} ->
    processChatCommand $ APITestProtoServer userId srv
-  APISetChatItemTTL userId newTTL_ -> withUser $ \user -> do
-    checkSameUser userId user
+  APISetChatItemTTL userId newTTL_ -> withUserId userId $ \user ->
    checkStoreNotChanged $
      withChatLock "setChatItemTTL" $ do
        case newTTL_ of
@@ -1229,7 +1228,7 @@ processChatCommand = \case
        ok user
  SetChatItemTTL newTTL_ -> withUser' $ \User {userId} -> do
    processChatCommand $ APISetChatItemTTL userId newTTL_
-  APIGetChatItemTTL userId -> withUserId userId $ \user -> do
+  APIGetChatItemTTL userId -> withUserId' userId $ \user -> do
    ttl <- withStoreCtx' (Just "APIGetChatItemTTL, getChatItemTTL") (`getChatItemTTL` user)
    pure $ CRChatItemTTL user ttl
  GetChatItemTTL -> withUser' $ \User {userId} -> do
@@ -1489,9 +1488,9 @@ processChatCommand = \case
    pure $ CRUserContactLinkDeleted user'
  DeleteMyAddress -> withUser $ \User {userId} ->
    processChatCommand $ APIDeleteMyAddress userId
-  APIShowMyAddress userId -> withUserId userId $ \user ->
+  APIShowMyAddress userId -> withUserId' userId $ \user ->
    CRUserContactLink user <$> withStoreCtx (Just "APIShowMyAddress, getUserAddress") (`getUserAddress` user)
-  ShowMyAddress -> withUser $ \User {userId} ->
+  ShowMyAddress -> withUser' $ \User {userId} ->
    processChatCommand $ APIShowMyAddress userId
  APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do
    let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
@@ -3236,23 +3235,24 @@ processAgentMsgRcvFile _corrId aFileId msg =
            toView $ CRRcvFileError user ci e

 processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
-processAgentMessageConn user _ agentConnId END =
-  withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= \case
-    RcvDirectMsgConnection _ (Just ct) -> toView $ CRContactAnotherClient user ct
-    entity -> toView $ CRSubscriptionEnd user entity
 processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
  entity <- withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= updateConnStatus
-  case entity of
-    RcvDirectMsgConnection conn contact_ ->
-      processDirectMessage agentMessage entity conn contact_
-    RcvGroupMsgConnection conn gInfo m ->
-      processGroupMessage agentMessage entity conn gInfo m
-    RcvFileConnection conn ft ->
-      processRcvFileConn agentMessage entity conn ft
-    SndFileConnection conn ft ->
-      processSndFileConn agentMessage entity conn ft
-    UserContactConnection conn uc ->
-      processUserContactRequest agentMessage entity conn uc
+  case agentMessage of
+    END -> case entity of
+      RcvDirectMsgConnection _ (Just ct) -> toView $ CRContactAnotherClient user ct
+      _ -> toView $ CRSubscriptionEnd user entity
+    MSGNTF smpMsgInfo -> toView $ CRNtfMessage user entity $ ntfMsgInfo smpMsgInfo
+    _ -> case entity of
+      RcvDirectMsgConnection conn contact_ ->
+        processDirectMessage agentMessage entity conn contact_
+      RcvGroupMsgConnection conn gInfo m ->
+        processGroupMessage agentMessage entity conn gInfo m
+      RcvFileConnection conn ft ->
+        processRcvFileConn agentMessage entity conn ft
+      SndFileConnection conn ft ->
+        processSndFileConn agentMessage entity conn ft
+      UserContactConnection conn uc ->
+        processUserContactRequest agentMessage entity conn uc
  where
    updateConnStatus :: ConnectionEntity -> m ConnectionEntity
    updateConnStatus acEntity = case agentMsgConnStatus agentMessage of
@@ -5919,6 +5919,11 @@ withUser action = withUser' $ \user ->
 withUser_ :: ChatMonad m => m ChatResponse -> m ChatResponse
 withUser_ = withUser . const

+withUserId' :: ChatMonad m => UserId -> (User -> m ChatResponse) -> m ChatResponse
+withUserId' userId action = withUser' $ \user -> do
+  checkSameUser userId user
+  action user
+
 withUserId :: ChatMonad m => UserId -> (User -> m ChatResponse) -> m ChatResponse
 withUserId userId action = withUser $ \user -> do
  checkSameUser userId user
@@ -5968,7 +5973,8 @@ chatCommandP =
      "/_start subscribe=" *> (StartChat <$> onOffP <* " expire=" <*> onOffP <* " xftp=" <*> onOffP),
      "/_start" $> StartChat True True True,
      "/_stop" $> APIStopChat,
-      "/_app activate" $> APIActivateChat,
+      "/_app activate restore=" *> (APIActivateChat <$> onOffP),
+      "/_app activate" $> APIActivateChat True,
      "/_app suspend " *> (APISuspendChat <$> A.decimal),
      "/_resubscribe all" $> ResubscribeAllConnections,
      "/_temp_folder " *> (SetTempFolder <$> filePath),
@@ -5983,9 +5989,9 @@ chatCommandP =
      "/_db import " *> (APIImportArchive <$> jsonP),
      "/_db delete" $> APIDeleteStorage,
      "/_db encryption " *> (APIStorageEncryption <$> jsonP),
-      "/db encrypt " *> (APIStorageEncryption . DBEncryptionConfig "" <$> dbKeyP),
-      "/db key " *> (APIStorageEncryption <$> (DBEncryptionConfig <$> dbKeyP <* A.space <*> dbKeyP)),
-      "/db decrypt " *> (APIStorageEncryption . (`DBEncryptionConfig` "") <$> dbKeyP),
+      "/db encrypt " *> (APIStorageEncryption . dbEncryptionConfig "" <$> dbKeyP),
+      "/db key " *> (APIStorageEncryption <$> (dbEncryptionConfig <$> dbKeyP <* A.space <*> dbKeyP)),
+      "/db decrypt " *> (APIStorageEncryption . (`dbEncryptionConfig` "") <$> dbKeyP),
      "/sql chat " *> (ExecChatStoreSQL <$> textP),
      "/sql agent " *> (ExecAgentStoreSQL <$> textP),
      "/sql slow" $> SlowSQLQueries,
@@ -6338,7 +6344,8 @@ chatCommandP =
          A.decimal
        ]
    dbKeyP = nonEmptyKey <$?> strP
-    nonEmptyKey k@(DBEncryptionKey s) = if null s then Left "empty key" else Right k
+    nonEmptyKey k@(DBEncryptionKey s) = if BA.null s then Left "empty key" else Right k
+    dbEncryptionConfig currentKey newKey = DBEncryptionConfig {currentKey, newKey, keepKey = Just False}
    autoAcceptP =
      ifM
        onOffP
@@ -17,12 +17,14 @@ import qualified Codec.Archive.Zip as Z
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import qualified Data.ByteArray as BA
 import Data.Functor (($>))
+import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Database.SQLite3 as SQL
 import Simplex.Chat.Controller
 import Simplex.Messaging.Agent.Client (agentClientStore)
-import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), closeSQLiteStore, sqlString)
+import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), closeSQLiteStore, keyString, sqlString, storeKey)
 import Simplex.Messaging.Util
 import System.FilePath
 import UnliftIO.Directory
@@ -118,7 +120,7 @@ storageFiles = do
  pure StorageFiles {chatStore, agentStore, filesPath}

 sqlCipherExport :: forall m. ChatMonad m => DBEncryptionConfig -> m ()
-sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = DBEncryptionKey key'} =
+sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = DBEncryptionKey key', keepKey} =
  when (key /= key') $ do
    fs <- storageFiles
    checkFile `withDBs` fs
@@ -134,15 +136,15 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
    backup f = copyFile f (f <> ".bak")
    restore f = copyFile (f <> ".bak") f
    checkFile f = unlessM (doesFileExist f) $ throwDBError $ DBErrorNoFile f
-    checkEncryption SQLiteStore {dbEncrypted} = do
-      enc <- readTVarIO dbEncrypted
-      when (enc && null key) $ throwDBError DBErrorEncrypted
-      when (not enc && not (null key)) $ throwDBError DBErrorPlaintext
+    checkEncryption SQLiteStore {dbKey} = do
+      enc <- maybe True (not . BA.null) <$> readTVarIO dbKey
+      when (enc && BA.null key) $ throwDBError DBErrorEncrypted
+      when (not enc && not (BA.null key)) $ throwDBError DBErrorPlaintext
    exported = (<> ".exported")
    removeExported f = whenM (doesFileExist $ exported f) $ removeFile (exported f)
-    moveExported SQLiteStore {dbFilePath = f, dbEncrypted} = do
+    moveExported SQLiteStore {dbFilePath = f, dbKey} = do
      renameFile (exported f) f
-      atomically $ writeTVar dbEncrypted $ not (null key')
+      atomically $ writeTVar dbKey $ storeKey key' (fromMaybe False keepKey)
    export f = do
      withDB f (`SQL.exec` exportSQL) DBErrorExport
      withDB (exported f) (`SQL.exec` testSQL) DBErrorOpen
@@ -161,7 +163,7 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
        exportSQL =
          T.unlines $
            keySQL key
-              <> [ "ATTACH DATABASE " <> sqlString (f <> ".exported") <> " AS exported KEY " <> sqlString key' <> ";",
+              <> [ "ATTACH DATABASE " <> sqlString (T.pack f <> ".exported") <> " AS exported KEY " <> keyString key' <> ";",
                   "SELECT sqlcipher_export('exported');",
                   "DETACH DATABASE exported;"
                 ]
@@ -172,7 +174,7 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
                   "PRAGMA secure_delete = ON;",
                   "SELECT count(*) FROM sqlite_master;"
                 ]
-        keySQL k = ["PRAGMA key = " <> sqlString k <> ";" | not (null k)]
+        keySQL k = ["PRAGMA key = " <> keyString k <> ";" | not (BA.null k)]

 withDBs :: Monad m => (FilePath -> m b) -> StorageFiles -> m b
 action `withDBs` StorageFiles {chatStore, agentStore} = action (dbFilePath chatStore) >> action (dbFilePath agentStore)
@@ -29,6 +29,8 @@ import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (ord)
@@ -39,7 +41,9 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.String
 import Data.Text (Text)
+import Data.Text.Encoding (decodeLatin1)
 import Data.Time (NominalDiffTime, UTCTime)
+import Data.Time.Clock.System (systemToUTCTime)
 import Data.Version (showVersion)
 import Data.Word (Word16)
 import Language.Haskell.TH (Exp, Q, runIO)
@@ -69,7 +73,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SMPMsgMeta (..), SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol)
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (TLS, simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -230,7 +234,7 @@ data ChatCommand
  | DeleteUser UserName Bool (Maybe UserPwd)
  | StartChat {subscribeConnections :: Bool, enableExpireChatItems :: Bool, startXFTPWorkers :: Bool}
  | APIStopChat
-  | APIActivateChat
+  | APIActivateChat {restoreChat :: Bool}
  | APISuspendChat {suspendTimeout :: Int}
  | ResubscribeAllConnections
  | SetTempFolder FilePath
@@ -455,7 +459,7 @@ allowRemoteCommand :: ChatCommand -> Bool -- XXX: consider using Relay/Block/For
 allowRemoteCommand = \case
  StartChat {} -> False
  APIStopChat -> False
-  APIActivateChat -> False
+  APIActivateChat _ -> False
  APISuspendChat _ -> False
  QuitChat -> False
  SetTempFolder _ -> False
@@ -656,7 +660,8 @@ data ChatResponse
  | CRUserContactLinkSubError {chatError :: ChatError} -- TODO delete
  | CRNtfTokenStatus {status :: NtfTknStatus}
  | CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode}
-  | CRNtfMessages {user_ :: Maybe User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
+  | CRNtfMessages {user_ :: Maybe User, connEntity_ :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
+  | CRNtfMessage {user :: User, connEntity :: ConnectionEntity, ntfMessage :: NtfMsgInfo}
  | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
  | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
  | CRCurrentRemoteHost {remoteHost_ :: Maybe RemoteHostInfo}
@@ -848,17 +853,17 @@ deriving instance Show AUserProtoServers
 data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
  deriving (Show)

-data DBEncryptionConfig = DBEncryptionConfig {currentKey :: DBEncryptionKey, newKey :: DBEncryptionKey}
+data DBEncryptionConfig = DBEncryptionConfig {currentKey :: DBEncryptionKey, newKey :: DBEncryptionKey, keepKey :: Maybe Bool}
  deriving (Show)

-newtype DBEncryptionKey = DBEncryptionKey String
+newtype DBEncryptionKey = DBEncryptionKey ScrubbedBytes
  deriving (Show)

 instance IsString DBEncryptionKey where fromString = parseString $ parseAll strP

 instance StrEncoding DBEncryptionKey where
-  strEncode (DBEncryptionKey s) = B.pack s
-  strP = DBEncryptionKey . B.unpack <$> A.takeWhile (\c -> c /= ' ' && ord c >= 0x21 && ord c <= 0x7E)
+  strEncode (DBEncryptionKey s) = BA.convert s
+  strP = DBEncryptionKey . BA.convert <$> A.takeWhile (\c -> c /= ' ' && ord c >= 0x21 && ord c <= 0x7E)

 instance FromJSON DBEncryptionKey where
  parseJSON = strParseJSON "DBEncryptionKey"
@@ -923,9 +928,12 @@ data XFTPFileConfig = XFTPFileConfig
 defaultXFTPFileConfig :: XFTPFileConfig
 defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0}

-data NtfMsgInfo = NtfMsgInfo {msgTs :: UTCTime, msgFlags :: MsgFlags}
+data NtfMsgInfo = NtfMsgInfo {msgId :: Text, msgTs :: UTCTime}
  deriving (Show)

+ntfMsgInfo :: SMPMsgMeta -> NtfMsgInfo
+ntfMsgInfo SMPMsgMeta {msgId, msgTs} = NtfMsgInfo {msgId = decodeLatin1 $ strEncode msgId, msgTs = systemToUTCTime msgTs}
+
 crNtfToken :: (DeviceToken, NtfTknStatus, NotificationsMode) -> ChatResponse
 crNtfToken (token, status, ntfMode) = CRNtfToken {token, status, ntfMode}

@@ -22,7 +22,7 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {core
      withGlobalLogging logCfg initRun
    _ -> initRun
  where
-    initRun = createChatDatabase dbFilePrefix dbKey confirmMigrations >>= either exit run
+    initRun = createChatDatabase dbFilePrefix dbKey False confirmMigrations >>= either exit run
    exit e = do
      putStrLn $ "Error opening database: " <> show e
      exitFailure
@@ -15,6 +15,8 @@ import Control.Monad.Reader
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
 import Data.Bifunctor (first)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -44,7 +46,7 @@ import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Client (agentClientStore)
 import Simplex.Messaging.Agent.Env.SQLite (createAgentStore)
-import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, closeSQLiteStore)
+import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, closeSQLiteStore, reopenSQLiteStore)
 import Simplex.Messaging.Client (defaultNetworkConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -70,8 +72,12 @@ $(JQ.deriveToJSON defaultJSON ''APIResponse)

 foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString

+foreign export ccall "chat_migrate_init_key" cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
+
 foreign export ccall "chat_close_store" cChatCloseStore :: StablePtr ChatController -> IO CString

+foreign export ccall "chat_reopen_store" cChatReopenStore :: StablePtr ChatController -> IO CString
+
 foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString

 foreign export ccall "chat_send_remote_cmd" cChatSendRemoteCmd :: StablePtr ChatController -> CInt -> CString -> IO CJSONString
@@ -102,7 +108,10 @@ foreign export ccall "chat_decrypt_file" cChatDecryptFile :: CString -> CString

 -- | check / migrate database and initialize chat controller on success
 cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
-cChatMigrateInit fp key conf ctrl = do
+cChatMigrateInit fp key = cChatMigrateInitKey fp key 0
+
+cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
+cChatMigrateInitKey fp key keepKey conf ctrl = do
  -- ensure we are set to UTF-8; iOS does not have locale, and will default to
  -- US-ASCII all the time.
  setLocaleEncoding utf8
@@ -110,10 +119,10 @@ cChatMigrateInit fp key conf ctrl = do
  setForeignEncoding utf8

  dbPath <- peekCAString fp
-  dbKey <- peekCAString key
+  dbKey <- BA.convert <$> B.packCString key
  confirm <- peekCAString conf
  r <-
-    chatMigrateInit dbPath dbKey confirm >>= \case
+    chatMigrateInitKey dbPath dbKey (keepKey /= 0) confirm >>= \case
      Right cc -> (newStablePtr cc >>= poke ctrl) $> DBMOk
      Left e -> pure e
  newCStringFromLazyBS $ J.encode r
@@ -121,6 +130,11 @@ cChatMigrateInit fp key conf ctrl = do
 cChatCloseStore :: StablePtr ChatController -> IO CString
 cChatCloseStore cPtr = deRefStablePtr cPtr >>= chatCloseStore >>= newCAString

+cChatReopenStore :: StablePtr ChatController -> IO CString
+cChatReopenStore cPtr = do
+  c <- deRefStablePtr cPtr
+  newCAString =<< chatReopenStore c
+
 -- | send command to chat (same syntax as in terminal for now)
 cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
 cChatSendCmd cPtr cCmd = do
@@ -162,13 +176,13 @@ cChatPasswordHash cPwd cSalt = do
 cChatValidName :: CString -> IO CString
 cChatValidName cName = newCString . mkValidName =<< peekCString cName

-mobileChatOpts :: String -> String -> ChatOpts
-mobileChatOpts dbFilePrefix dbKey =
+mobileChatOpts :: String -> ChatOpts
+mobileChatOpts dbFilePrefix =
  ChatOpts
    { coreOptions =
        CoreChatOpts
          { dbFilePrefix,
-            dbKey,
+            dbKey = "", -- for API database is already opened, and the key in options is not used
            smpServers = [],
            xftpServers = [],
            networkConfig = defaultNetworkConfig,
@@ -205,8 +219,11 @@ defaultMobileConfig =
 getActiveUser_ :: SQLiteStore -> IO (Maybe User)
 getActiveUser_ st = find activeUser <$> withTransaction st getUsers

-chatMigrateInit :: String -> String -> String -> IO (Either DBMigrationResult ChatController)
-chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
+chatMigrateInit :: String -> ScrubbedBytes -> String -> IO (Either DBMigrationResult ChatController)
+chatMigrateInit dbFilePrefix dbKey = chatMigrateInitKey dbFilePrefix dbKey False
+
+chatMigrateInitKey :: String -> ScrubbedBytes -> Bool -> String -> IO (Either DBMigrationResult ChatController)
+chatMigrateInitKey dbFilePrefix dbKey keepKey confirm = runExceptT $ do
  confirmMigrations <- liftEitherWith (const DBMInvalidConfirmation) $ strDecode $ B.pack confirm
  chatStore <- migrate createChatStore (chatStoreFile dbFilePrefix) confirmMigrations
  agentStore <- migrate createAgentStore (agentStoreFile dbFilePrefix) confirmMigrations
@@ -214,10 +231,10 @@ chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
  where
    initialize st db = do
      user_ <- getActiveUser_ st
-      newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix dbKey)
+      newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix)
    migrate createStore dbFile confirmMigrations =
      ExceptT $
-        (first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey confirmMigrations)
+        (first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey keepKey confirmMigrations)
          `catch` (pure . checkDBError)
          `catchAll` (pure . dbError)
      where
@@ -231,6 +248,11 @@ chatCloseStore ChatController {chatStore, smpAgent} = handleErr $ do
  closeSQLiteStore chatStore
  closeSQLiteStore $ agentClientStore smpAgent

+chatReopenStore :: ChatController -> IO String
+chatReopenStore ChatController {chatStore, smpAgent} = handleErr $ do
+  reopenSQLiteStore chatStore
+  reopenSQLiteStore (agentClientStore smpAgent)
+
 handleErr :: IO () -> IO String
 handleErr a = (a $> "") `catch` (pure . show @SomeException)

@@ -18,6 +18,7 @@ where

 import Control.Logger.Simple (LogLevel (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteString.Char8 as B
 import Data.Text (Text)
 import Numeric.Natural (Natural)
@@ -48,7 +49,7 @@ data ChatOpts = ChatOpts

 data CoreChatOpts = CoreChatOpts
  { dbFilePrefix :: String,
-    dbKey :: String,
+    dbKey :: ScrubbedBytes,
    smpServers :: [SMPServerWithAuth],
    xftpServers :: [XFTPServerWithAuth],
    networkConfig :: NetworkConfig,
@@ -189,7 +189,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
        RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessionCode tls rhs')
        _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
      let rh_' = (\rh -> (rh :: RemoteHostInfo) {sessionState = Just RHSPendingConfirmation {sessionCode}}) <$> remoteHost_
-      toView $ CRRemoteHostSessionCode {remoteHost_ = rh_', sessionCode}
+      toView CRRemoteHostSessionCode {remoteHost_ = rh_', sessionCode}
      (RCHostSession {sessionKeys}, rhHello, pairing') <- timeoutThrow (ChatErrorRemoteHost rhKey RHETimeout) 60000000 $ takeRCStep vars'
      hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
        liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
@@ -260,7 +260,7 @@ cancelRemoteHostSession handlerInfo_ rhKey = do
    atomically $
      TM.lookup rhKey sessions >>= \case
        Nothing -> pure Nothing
-        Just (sessSeq, _) | maybe False (/= sessSeq) (fst <$> handlerInfo_) -> pure Nothing -- ignore cancel from a ghost session handler
+        Just (sessSeq, _) | maybe False ((sessSeq /=) . fst) handlerInfo_ -> pure Nothing -- ignore cancel from a ghost session handler
        Just (_, rhs) -> do
          TM.delete rhKey sessions
          modifyTVar' crh $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
@@ -268,7 +268,7 @@ cancelRemoteHostSession handlerInfo_ rhKey = do
  forM_ deregistered $ \session -> do
    liftIO $ cancelRemoteHost handlingError session `catchAny` (logError . tshow)
    forM_ (snd <$> handlerInfo_) $ \rhStopReason ->
-      toView $ CRRemoteHostStopped {remoteHostId_, rhsState = rhsSessionState session, rhStopReason}
+      toView CRRemoteHostStopped {remoteHostId_, rhsState = rhsSessionState session, rhStopReason}
  where
    handlingError = isJust handlerInfo_
    remoteHostId_ = case rhKey of
@@ -12,13 +12,14 @@ module Simplex.Chat.Store
  )
 where

+import Data.ByteArray (ScrubbedBytes)
 import Simplex.Chat.Store.Migrations
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Store.Shared
 import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, MigrationError, SQLiteStore (..), createSQLiteStore, withTransaction)

-createChatStore :: FilePath -> String -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
-createChatStore dbPath dbKey = createSQLiteStore dbPath dbKey migrations
+createChatStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
+createChatStore dbPath key keepKey = createSQLiteStore dbPath key keepKey migrations

 chatStoreFile :: FilePath -> FilePath
 chatStoreFile = (<> "_chat.db")
@@ -278,6 +278,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
  CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
  CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
  CRNtfMessages {} -> []
+  CRNtfMessage {} -> []
  CRCurrentRemoteHost rhi_ ->
    [ maybe
        "Using local profile"