command to get/set SQLite journalling mode

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: cf75d4f5e479cdf031d391f32a3fc742178baecd
+    tag: 9cb8616d4648c9df7ca58fee7249c9cc611f1b4b
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."cf75d4f5e479cdf031d391f32a3fc742178baecd" = "1qgv658wvb9gf94n2ryklani26nffs7wilqa2dy3wzq7bsrl4c0w";
+  "https://github.com/simplex-chat/simplexmq.git"."9cb8616d4648c9df7ca58fee7249c9cc611f1b4b" = "0rdk14bi3f0ny9wmc4rmb80pvimhijh3a21y2fq22amiy380d043";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
   "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, checkpointSQLiteStore)
+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
@@ -517,6 +517,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
@@ -5402,6 +5412,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

@@ -44,16 +44,16 @@ exportArchive :: ChatMonad m => ArchiveConfig -> m ()
 exportArchive cfg@ArchiveConfig {archivePath, disableCompression} =
   handleErr $ withTempDir cfg "simplex-chat." $ \dir -> do
     fs@StorageFiles {chatStore, agentStore, filesPath} <- storageFiles
-    setWALMode False `withStores` fs
+    setWALMode SQLModeDelete `withStores` fs
     copyFile (dbFilePath chatStore) $ dir </> archiveChatDbFile
     copyFile (dbFilePath agentStore) $ dir </> archiveAgentDbFile
-    setWALMode True `withStores` fs
+    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 walMode st = liftIO $ setSQLiteModeWAL st walMode
+    setWALMode mode st = liftIO $ setSQLiteJournalMode st mode
 
 importArchive :: ChatMonad m => ArchiveConfig -> m [ArchiveError]
 importArchive cfg@ArchiveConfig {archivePath} =

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
@@ -238,6 +238,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)
@@ -584,6 +585,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/View.hs

@@ -266,6 +266,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: cf75d4f5e479cdf031d391f32a3fc742178baecd
+    commit: 9cb8616d4648c9df7ca58fee7249c9cc611f1b4b
   - github: kazu-yamamoto/http2
     commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
   # - ../direct-sqlcipher