update http2

apps/ios/SimpleXChat/SimpleX.h

@@ -17,7 +17,8 @@ typedef void* chat_ctrl;
 
 // the last parameter is used to return the pointer to chat controller
 extern char *chat_migrate_init(char *path, char *key, char *confirm, chat_ctrl *ctrl);
-extern char *chat_close_store(chat_ctrl ctl);
+extern char *chat_close_store(chat_ctrl ctl)
+extern char *chat_open_store(chat_ctrl ctl, char *key);
 extern char *chat_send_cmd(chat_ctrl ctl, char *cmd);
 extern char *chat_recv_msg(chat_ctrl ctl);
 extern char *chat_recv_msg_wait(chat_ctrl ctl, int wait);

cabal.project

@@ -9,7 +9,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: e9b5a849ab18de085e8c69d239a9706b99bcf787
+    tag: 7ebb63025cc70d0649830b31846deba2348c3c38
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."e9b5a849ab18de085e8c69d239a9706b99bcf787" = "0b50mlnzwian4l9kx4niwnj9qkyp21ryc8x9d3il9jkdfxrx8kqi";
+  "https://github.com/simplex-chat/simplexmq.git"."7ebb63025cc70d0649830b31846deba2348c3c38" = "151lpqvbc04ql6xxyjrp0l06hp2l4pf0hyhqp654gz0xbfp5s40j";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/kazu-yamamoto/http2.git"."f5525b755ff2418e6e6ecc69e877363b0d0bcaeb" = "0fyx0047gvhm99ilp212mmz37j84cwrfnpmssib5dw363fyb88b6";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";

src/Simplex/Chat.hs

@@ -82,7 +82,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)
+import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, SQLiteStore (dbNew), execSQL, upMigration, withConnection, checkpointSQLiteStore, getSQLiteJournalMode, setSQLiteJournalMode)
 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
@@ -356,7 +356,7 @@ restoreCalls = do
   atomically $ writeTVar calls callsMap
 
 stopChatController :: forall m. MonadUnliftIO m => ChatController -> m ()
-stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags} = do
+stopChatController ChatController {chatStore, smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags} = do
   disconnectAgentClient smpAgent
   readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
   closeFiles sndFiles
@@ -365,6 +365,9 @@ stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles,
     keys <- M.keys <$> readTVar expireCIFlags
     forM_ keys $ \k -> TM.insert k False expireCIFlags
     writeTVar s Nothing
+  let agentStore = agentClientStore smpAgent
+  liftIO $ checkpointSQLiteStore chatStore
+  liftIO $ checkpointSQLiteStore agentStore
   where
     closeFiles :: TVar (Map Int64 Handle) -> m ()
     closeFiles files = do
@@ -549,6 +552,16 @@ processChatCommand = \case
             . sortOn (timeAvg . snd)
             . M.assocs
             <$> withConnection st (readTVarIO . DB.slow)
+  StoreSQLMode mode_ -> checkChatStopped $ do
+    ChatController {chatStore, smpAgent} <- ask
+    let agentStore = agentClientStore smpAgent
+    forM_ mode_ $ \mode -> do
+      setStoreChanged
+      liftIO $ setSQLiteJournalMode chatStore mode >> setSQLiteJournalMode agentStore mode
+    liftIO $ do
+      chatMode <- getSQLiteJournalMode chatStore
+      agentMode <- getSQLiteJournalMode agentStore
+      pure CRStoreSQLMode {chatMode, agentMode}
   APIGetChats userId withPCC -> withUserId userId $ \user ->
     CRApiChats user <$> withStoreCtx' (Just "APIGetChats, getChatPreviews") (\db -> getChatPreviews db user withPCC)
   APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
@@ -5679,6 +5692,7 @@ chatCommandP =
       "/sql chat " *> (ExecChatStoreSQL <$> textP),
       "/sql agent " *> (ExecAgentStoreSQL <$> textP),
       "/sql slow" $> SlowSQLQueries,
+      "/sql mode" *> (StoreSQLMode <$> optional (A.space *> strP)),
       "/_get chats " *> (APIGetChats <$> A.decimal <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)),
       "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
       "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),

src/Simplex/Chat/Archive.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Chat.Archive
   ( exportArchive,
@@ -21,7 +22,7 @@ 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 (..), sqlString, closeSQLiteStore)
+import Simplex.Messaging.Agent.Store.SQLite
 import Simplex.Messaging.Util
 import System.FilePath
 import UnliftIO.Directory
@@ -41,28 +42,31 @@ archiveFilesFolder = "simplex_v1_files"
 
 exportArchive :: ChatMonad m => ArchiveConfig -> m ()
 exportArchive cfg@ArchiveConfig {archivePath, disableCompression} =
-  withTempDir cfg "simplex-chat." $ \dir -> do
-    StorageFiles {chatStore, agentStore, filesPath} <- storageFiles
+  handleErr $ withTempDir cfg "simplex-chat." $ \dir -> do
+    fs@StorageFiles {chatStore, agentStore, filesPath} <- storageFiles
+    setWALMode SQLModeDelete `withStores` fs
     copyFile (dbFilePath chatStore) $ dir </> archiveChatDbFile
     copyFile (dbFilePath agentStore) $ dir </> archiveAgentDbFile
+    setWALMode SQLModeWAL `withStores` fs
     forM_ filesPath $ \fp ->
       copyDirectoryFiles fp $ dir </> archiveFilesFolder
     let method = if disableCompression == Just True then Z.Store else Z.Deflate
     Z.createArchive archivePath $ Z.packDirRecur method Z.mkEntrySelector dir
+  where
+    setWALMode mode st = liftIO $ setSQLiteJournalMode st mode
 
 importArchive :: ChatMonad m => ArchiveConfig -> m [ArchiveError]
 importArchive cfg@ArchiveConfig {archivePath} =
-  withTempDir cfg "simplex-chat." $ \dir -> do
+  handleErr $ withTempDir cfg "simplex-chat." $ \dir -> do
     Z.withArchive archivePath $ Z.unpackInto dir
     fs@StorageFiles {chatStore, agentStore, filesPath} <- storageFiles
-    liftIO $ closeSQLiteStore `withStores` fs
-    backup `withDBs` fs
+    liftIO $ (closeSQLiteStore `withStores` fs) `catch` print @SomeException
+    liftIO $ backupSQLiteStore `withStores` fs
     copyFile (dir </> archiveChatDbFile) $ dbFilePath chatStore
     copyFile (dir </> archiveAgentDbFile) $ dbFilePath agentStore
     copyFiles dir filesPath
       `E.catch` \(e :: E.SomeException) -> pure [AEImport . ChatError . CEException $ show e]
   where
-    backup f = whenM (doesFileExist f) $ copyFile f $ f <> ".bak"
     copyFiles dir filesPath = do
       let filesDir = dir </> archiveFilesFolder
       case filesPath of
@@ -93,16 +97,18 @@ copyDirectoryFiles fromDir toDir = do
       whenM (doesFileExist f') $ copyFile f' $ toDir </> fn
 
 deleteStorage :: ChatMonad m => m ()
-deleteStorage = do
+deleteStorage = handleErr $ do
   fs <- storageFiles
   liftIO $ closeSQLiteStore `withStores` fs
-  remove `withDBs` fs
+  liftIO $ removeSQLiteStore `withStores` fs
   mapM_ removeDir $ filesPath fs
   mapM_ removeDir =<< chatReadVar tempDirectory
   where
-    remove f = whenM (doesFileExist f) $ removeFile f
     removeDir d = whenM (doesDirectoryExist d) $ removePathForcibly d
 
+handleErr :: ChatMonad m => m a -> m a
+handleErr = E.handle (throwError . mkChatError)
+
 data StorageFiles = StorageFiles
   { chatStore :: SQLiteStore,
     agentStore :: SQLiteStore,
@@ -121,17 +127,15 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
   when (key /= key') $ do
     fs <- storageFiles
     checkFile `withDBs` fs
-    backup `withDBs` fs
+    liftIO $ backupSQLiteStore `withStores` fs
     checkEncryption `withStores` fs
     removeExported `withDBs` fs
     export `withDBs` fs
     -- closing after encryption prevents closing in case wrong encryption key was passed
     liftIO $ closeSQLiteStore `withStores` fs
     (moveExported `withStores` fs)
-      `catchChatError` \e -> (restore `withDBs` fs) >> throwError e
+      `catchChatError` \e -> liftIO (restoreSQLiteStore `withStores` fs) >> throwError e
   where
-    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
@@ -161,6 +165,7 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
           T.unlines $
             keySQL key
               <> [ "ATTACH DATABASE " <> sqlString (f <> ".exported") <> " AS exported KEY " <> sqlString key' <> ";",
+                   "PRAGMA wal_checkpoint(TRUNCATE);",
                    "SELECT sqlcipher_export('exported');",
                    "DETACH DATABASE exported;"
                  ]
@@ -173,8 +178,8 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
                  ]
         keySQL k = ["PRAGMA key = " <> sqlString k <> ";" | not (null k)]
 
-withDBs :: Monad m => (FilePath -> m b) -> StorageFiles -> m b
+withDBs :: Monad m => (FilePath -> m a) -> StorageFiles -> m a
 action `withDBs` StorageFiles {chatStore, agentStore} = action (dbFilePath chatStore) >> action (dbFilePath agentStore)
 
-withStores :: Monad m => (SQLiteStore -> m b) -> StorageFiles -> m b
+withStores :: Monad m => (SQLiteStore -> m a) -> StorageFiles -> m a
 action `withStores` StorageFiles {chatStore, agentStore} = action chatStore >> action agentStore

src/Simplex/Chat/Controller.hs

@@ -54,7 +54,7 @@ import Simplex.Messaging.Agent.Client (AgentLocks, ProtocolTestFailure)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction)
+import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, SQLiteJournalMode, UpMigration, withTransaction)
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
@@ -232,6 +232,7 @@ data ChatCommand
   | ExecChatStoreSQL Text
   | ExecAgentStoreSQL Text
   | SlowSQLQueries
+  | StoreSQLMode (Maybe SQLiteJournalMode)
   | APIGetChats {userId :: UserId, pendingConnections :: Bool}
   | APIGetChat ChatRef ChatPagination (Maybe String)
   | APIGetChatItems ChatPagination (Maybe String)
@@ -588,6 +589,7 @@ data ChatResponse
   | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
+  | CRStoreSQLMode {chatMode :: SQLiteJournalMode, agentMode :: SQLiteJournalMode}
   | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
   | CRAgentStats {agentStats :: [[String]]}
   | CRAgentSubs {activeSubs :: Map Text Int, pendingSubs :: Map Text Int, removedSubs :: Map Text [String]}

src/Simplex/Chat/Mobile.hs

@@ -43,7 +43,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, openSQLiteStore)
 import Simplex.Messaging.Client (defaultNetworkConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -57,6 +57,8 @@ foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString
 
 foreign export ccall "chat_close_store" cChatCloseStore :: StablePtr ChatController -> IO CString
 
+foreign export ccall "chat_open_store" cChatOpenStore :: StablePtr ChatController -> CString -> IO CString
+
 foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
 
 foreign export ccall "chat_recv_msg" cChatRecvMsg :: StablePtr ChatController -> IO CJSONString
@@ -104,6 +106,12 @@ cChatMigrateInit fp key conf ctrl = do
 cChatCloseStore :: StablePtr ChatController -> IO CString
 cChatCloseStore cPtr = deRefStablePtr cPtr >>= chatCloseStore >>= newCAString
 
+cChatOpenStore :: StablePtr ChatController -> CString -> IO CString
+cChatOpenStore cPtr cKey = do
+  c <- deRefStablePtr cPtr
+  key <- peekCAString cKey
+  newCAString =<< chatOpenStore c key
+
 -- | send command to chat (same syntax as in terminal for now)
 cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
 cChatSendCmd cPtr cCmd = do
@@ -214,9 +222,14 @@ chatCloseStore ChatController {chatStore, smpAgent} = handleErr $ do
   closeSQLiteStore chatStore
   closeSQLiteStore $ agentClientStore smpAgent
 
+chatOpenStore :: ChatController -> String -> IO String
+chatOpenStore ChatController {chatStore, smpAgent} key = handleErr $ do
+  openSQLiteStore chatStore key
+  openSQLiteStore (agentClientStore smpAgent) key
+
 handleErr :: IO () -> IO String
 handleErr a = (a $> "") `catch` (pure . show @SomeException)
-  
+
 chatSendCmd :: ChatController -> ByteString -> IO JSONByteString
 chatSendCmd cc s = J.encode . APIResponse Nothing <$> runReaderT (execChatCommand s) cc
 

src/Simplex/Chat/View.hs

@@ -272,6 +272,9 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
             <> (" :: avg: " <> sShow timeAvg <> " ms")
             <> (" :: " <> plain (T.unwords $ T.lines query))
      in ("Chat queries" : map viewQuery chatQueries) <> [""] <> ("Agent queries" : map viewQuery agentQueries)
+  CRStoreSQLMode {chatMode, agentMode} ->
+    let viewMode mode = plain $ "DB journal mode: " <> strEncode mode
+     in ["Chat " <> viewMode chatMode, "Agent " <> viewMode agentMode]      
   CRDebugLocks {chatLockName, agentLocks} ->
     [ maybe "no chat lock" (("chat lock: " <>) . plain) chatLockName,
       plain $ "agent locks: " <> LB.unpack (J.encode agentLocks)

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: e9b5a849ab18de085e8c69d239a9706b99bcf787
+    commit: 7ebb63025cc70d0649830b31846deba2348c3c38
   - github: kazu-yamamoto/http2
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher

tests/ChatClient.hs

@@ -24,6 +24,7 @@ import Network.Socket
 import Simplex.Chat
 import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..))
 import Simplex.Chat.Core
+import Simplex.Chat.Mobile (chatCloseStore)
 import Simplex.Chat.Options
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Profiles
@@ -184,6 +185,7 @@ stopTestChat TestCC {chatController = cc, chatAsync, termAsync} = do
   stopChatController cc
   uninterruptibleCancel termAsync
   uninterruptibleCancel chatAsync
+  chatCloseStore cc `shouldReturn` ""
   threadDelay 200000
 
 withNewTestChat :: HasCallStack => FilePath -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a

tests/MobileTests.hs

@@ -29,7 +29,7 @@ import Simplex.Chat.Mobile.WebRTC
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Types (AgentUserId (..), Profile (..))
-import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..))
+import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), closeSQLiteStore)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile(..), CryptoFileArgs (..))
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -209,9 +209,14 @@ testChatApi tmp = do
       f = chatStoreFile dbPrefix
   Right st <- createChatStore f "myKey" MCYesUp
   Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True
+  closeSQLiteStore st
   Right cc <- chatMigrateInit dbPrefix "myKey" "yesUp"
   Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" "yesUp"
   Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey" "yesUp"
+  chatCloseStore cc `shouldReturn` ""
+  chatOpenStore cc "" >>= (`shouldContain` "file is not a database")
+  chatOpenStore cc "anotherKey" >>= (`shouldContain` "file is not a database")
+  chatOpenStore cc "myKey" `shouldReturn` ""
   chatSendCmd cc "/u" `shouldReturn` activeUser
   chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUserExists
   chatSendCmd cc "/_start" `shouldReturn` chatStarted