core: api to save/get app settings to migrate them as part of the database (#3824)

* rfc: migrate app settings as part of export/import/migration

* export/import app settings

* test, fix

* chat: store app settings in db (#3834)

* chat: store app settings in db

* add combining with app-defaults

* commit schema

* test with tweaked settings

* remove unused error

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>

* remove app settings from export/import

* test, more settings

---------

Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>

src/Simplex/Chat.hs

@@ -68,6 +68,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Remote
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store
+import Simplex.Chat.Store.AppSettings
 import Simplex.Chat.Store.Connections
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Files
@@ -597,6 +598,8 @@ processChatCommand' vr = \case
     fileErrs <- importArchive cfg
     setStoreChanged
     pure $ CRArchiveImported fileErrs
+  APISaveAppSettings as -> withStore' (`saveAppSettings` as) >> ok_
+  APIGetAppSettings platformDefaults -> CRAppSettings <$> withStore' (`getAppSettings` platformDefaults)
   APIDeleteStorage -> withStoreChanged deleteStorage
   APIStorageEncryption cfg -> withStoreChanged $ sqlCipherExport cfg
   TestStorageEncryption key -> sqlCipherTestKey key >> ok_
@@ -6469,6 +6472,8 @@ chatCommandP =
       "/db key " *> (APIStorageEncryption <$> (dbEncryptionConfig <$> dbKeyP <* A.space <*> dbKeyP)),
       "/db decrypt " *> (APIStorageEncryption . (`dbEncryptionConfig` "") <$> dbKeyP),
       "/db test key " *> (TestStorageEncryption <$> dbKeyP),
+      "/_save app settings" *> (APISaveAppSettings <$> jsonP),
+      "/_get app settings" *> (APIGetAppSettings <$> optional (A.space *> jsonP)),
       "/sql chat " *> (ExecChatStoreSQL <$> textP),
       "/sql agent " *> (ExecAgentStoreSQL <$> textP),
       "/sql slow" $> SlowSQLQueries,

src/Simplex/Chat/AppSettings.hs

@@ -0,0 +1,190 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Chat.AppSettings where
+
+import Control.Applicative ((<|>))
+import Data.Aeson (FromJSON (..), (.:?))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Simplex.Messaging.Client (NetworkConfig, defaultNetworkConfig)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
+import Simplex.Messaging.Util (catchAll_)
+
+data AppPlatform = APIOS | APAndroid | APDesktop deriving (Show)
+
+data NotificationMode = NMOff | NMPeriodic | NMInstant deriving (Show)
+
+data NotificationPreviewMode = NPMHidden | NPMContact | NPMMessage deriving (Show)
+
+data LockScreenCalls = LSCDisable | LSCShow | LSCAccept deriving (Show)
+
+data AppSettings = AppSettings
+  { appPlatform :: Maybe AppPlatform,
+    networkConfig :: Maybe NetworkConfig,
+    privacyEncryptLocalFiles :: Maybe Bool,
+    privacyAcceptImages :: Maybe Bool,
+    privacyLinkPreviews :: Maybe Bool,
+    privacyShowChatPreviews :: Maybe Bool,
+    privacySaveLastDraft :: Maybe Bool,
+    privacyProtectScreen :: Maybe Bool,
+    notificationMode :: Maybe NotificationMode,
+    notificationPreviewMode :: Maybe NotificationPreviewMode,
+    webrtcPolicyRelay :: Maybe Bool,
+    webrtcICEServers :: Maybe [Text],
+    confirmRemoteSessions :: Maybe Bool,
+    connectRemoteViaMulticast :: Maybe Bool,
+    connectRemoteViaMulticastAuto :: Maybe Bool,
+    developerTools :: Maybe Bool,
+    confirmDBUpgrades :: Maybe Bool,
+    androidCallOnLockScreen :: Maybe LockScreenCalls,
+    iosCallKitEnabled :: Maybe Bool,
+    iosCallKitCallsInRecents :: Maybe Bool
+  }
+  deriving (Show)
+
+defaultAppSettings :: AppSettings
+defaultAppSettings =
+  AppSettings
+    { appPlatform = Nothing,
+      networkConfig = Just defaultNetworkConfig,
+      privacyEncryptLocalFiles = Just True,
+      privacyAcceptImages = Just True,
+      privacyLinkPreviews = Just True,
+      privacyShowChatPreviews = Just True,
+      privacySaveLastDraft = Just True,
+      privacyProtectScreen = Just False,
+      notificationMode = Just NMInstant,
+      notificationPreviewMode = Just NPMMessage,
+      webrtcPolicyRelay = Just True,
+      webrtcICEServers = Just [],
+      confirmRemoteSessions = Just False,
+      connectRemoteViaMulticast = Just True,
+      connectRemoteViaMulticastAuto = Just True,
+      developerTools = Just False,
+      confirmDBUpgrades = Just False,
+      androidCallOnLockScreen = Just LSCShow,
+      iosCallKitEnabled = Just True,
+      iosCallKitCallsInRecents = Just False
+    }
+
+defaultParseAppSettings :: AppSettings
+defaultParseAppSettings =
+  AppSettings
+    { appPlatform = Nothing,
+      networkConfig = Nothing,
+      privacyEncryptLocalFiles = Nothing,
+      privacyAcceptImages = Nothing,
+      privacyLinkPreviews = Nothing,
+      privacyShowChatPreviews = Nothing,
+      privacySaveLastDraft = Nothing,
+      privacyProtectScreen = Nothing,
+      notificationMode = Nothing,
+      notificationPreviewMode = Nothing,
+      webrtcPolicyRelay = Nothing,
+      webrtcICEServers = Nothing,
+      confirmRemoteSessions = Nothing,
+      connectRemoteViaMulticast = Nothing,
+      connectRemoteViaMulticastAuto = Nothing,
+      developerTools = Nothing,
+      confirmDBUpgrades = Nothing,
+      androidCallOnLockScreen = Nothing,
+      iosCallKitEnabled = Nothing,
+      iosCallKitCallsInRecents = Nothing
+    }
+
+combineAppSettings :: AppSettings -> AppSettings -> AppSettings
+combineAppSettings platformDefaults storedSettings =
+  AppSettings
+    { appPlatform = p appPlatform, 
+      networkConfig = p networkConfig,
+      privacyEncryptLocalFiles = p privacyEncryptLocalFiles,
+      privacyAcceptImages = p privacyAcceptImages,
+      privacyLinkPreviews = p privacyLinkPreviews,
+      privacyShowChatPreviews = p privacyShowChatPreviews,
+      privacySaveLastDraft = p privacySaveLastDraft,
+      privacyProtectScreen = p privacyProtectScreen,
+      notificationMode = p notificationMode,
+      notificationPreviewMode = p notificationPreviewMode,
+      webrtcPolicyRelay = p webrtcPolicyRelay,
+      webrtcICEServers = p webrtcICEServers,
+      confirmRemoteSessions = p confirmRemoteSessions,
+      connectRemoteViaMulticast = p connectRemoteViaMulticast,
+      connectRemoteViaMulticastAuto = p connectRemoteViaMulticastAuto,
+      developerTools = p developerTools,
+      confirmDBUpgrades = p confirmDBUpgrades,
+      iosCallKitEnabled = p iosCallKitEnabled,
+      iosCallKitCallsInRecents = p iosCallKitCallsInRecents,
+      androidCallOnLockScreen = p androidCallOnLockScreen
+    }
+  where
+    p :: (AppSettings -> Maybe a) -> Maybe a
+    p sel = sel storedSettings <|> sel platformDefaults <|> sel defaultAppSettings
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "AP") ''AppPlatform)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "NM") ''NotificationMode)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "NPM") ''NotificationPreviewMode)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "LSC") ''LockScreenCalls)
+
+$(JQ.deriveToJSON defaultJSON ''AppSettings)
+
+instance FromJSON AppSettings where
+  parseJSON (J.Object v) = do
+    appPlatform <- p "appPlatform"
+    networkConfig <- p "networkConfig"
+    privacyEncryptLocalFiles <- p "privacyEncryptLocalFiles"
+    privacyAcceptImages <- p "privacyAcceptImages"
+    privacyLinkPreviews <- p "privacyLinkPreviews"
+    privacyShowChatPreviews <- p "privacyShowChatPreviews"
+    privacySaveLastDraft <- p "privacySaveLastDraft"
+    privacyProtectScreen <- p "privacyProtectScreen"
+    notificationMode <- p "notificationMode"
+    notificationPreviewMode <- p "notificationPreviewMode"
+    webrtcPolicyRelay <- p "webrtcPolicyRelay"
+    webrtcICEServers <- p "webrtcICEServers"
+    confirmRemoteSessions <- p "confirmRemoteSessions"
+    connectRemoteViaMulticast <- p "connectRemoteViaMulticast"
+    connectRemoteViaMulticastAuto <- p "connectRemoteViaMulticastAuto"
+    developerTools <- p "developerTools"
+    confirmDBUpgrades <- p "confirmDBUpgrades"
+    iosCallKitEnabled <- p "iosCallKitEnabled"
+    iosCallKitCallsInRecents <- p "iosCallKitCallsInRecents"
+    androidCallOnLockScreen <- p "androidCallOnLockScreen"
+    pure
+      AppSettings
+        { appPlatform,
+          networkConfig,
+          privacyEncryptLocalFiles,
+          privacyAcceptImages,
+          privacyLinkPreviews,
+          privacyShowChatPreviews,
+          privacySaveLastDraft,
+          privacyProtectScreen,
+          notificationMode,
+          notificationPreviewMode,
+          webrtcPolicyRelay,
+          webrtcICEServers,
+          confirmRemoteSessions,
+          connectRemoteViaMulticast,
+          connectRemoteViaMulticastAuto,
+          developerTools,
+          confirmDBUpgrades,
+          iosCallKitEnabled,
+          iosCallKitCallsInRecents,
+          androidCallOnLockScreen
+        }
+    where
+      p key = v .:? key <|> pure Nothing
+  parseJSON _ = pure defaultParseAppSettings
+
+readAppSettings :: FilePath -> Maybe AppSettings -> IO AppSettings
+readAppSettings f platformDefaults =
+  combineAppSettings (fromMaybe defaultAppSettings platformDefaults) . fromMaybe defaultParseAppSettings
+    <$> (J.decodeFileStrict f `catchAll_` pure Nothing)

src/Simplex/Chat/Controller.hs

@@ -49,6 +49,7 @@ import Data.Word (Word16)
 import Language.Haskell.TH (Exp, Q, runIO)
 import Numeric.Natural
 import qualified Paths_simplex_chat as SC
+import Simplex.Chat.AppSettings
 import Simplex.Chat.Call
 import Simplex.Chat.Markdown (MarkdownList)
 import Simplex.Chat.Messages
@@ -245,6 +246,8 @@ data ChatCommand
   | APIExportArchive ArchiveConfig
   | ExportArchive
   | APIImportArchive ArchiveConfig
+  | APISaveAppSettings AppSettings
+  | APIGetAppSettings (Maybe AppSettings)
   | APIDeleteStorage
   | APIStorageEncryption DBEncryptionConfig
   | TestStorageEncryption DBEncryptionKey
@@ -711,6 +714,7 @@ data ChatResponse
   | CRChatError {user_ :: Maybe User, chatError :: ChatError}
   | CRChatErrors {user_ :: Maybe User, chatErrors :: [ChatError]}
   | CRArchiveImported {archiveErrors :: [ArchiveError]}
+  | CRAppSettings {appSettings :: AppSettings}
   | CRTimedAction {action :: String, durationMilliseconds :: Int64}
   deriving (Show)
 

src/Simplex/Chat/Migrations/M20240222_app_settings.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20240222_app_settings where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20240222_app_settings :: Query
+m20240222_app_settings =
+  [sql|
+CREATE TABLE app_settings (
+  app_settings TEXT NOT NULL
+);
+|]
+
+down_m20240222_app_settings :: Query
+down_m20240222_app_settings =
+  [sql|
+DROP TABLE app_settings;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -562,6 +562,7 @@ CREATE TABLE note_folders(
   favorite INTEGER NOT NULL DEFAULT 0,
   unread_chat INTEGER NOT NULL DEFAULT 0
 );
+CREATE TABLE app_settings(app_settings TEXT NOT NULL);
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
   full_name

src/Simplex/Chat/Store/AppSettings.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Chat.Store.AppSettings where
+
+import Control.Monad (join)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Aeson as J
+import Data.Maybe (fromMaybe)
+import Database.SQLite.Simple (Only (..))
+import Simplex.Chat.AppSettings (AppSettings (..), combineAppSettings, defaultAppSettings, defaultParseAppSettings)
+import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+
+saveAppSettings :: DB.Connection -> AppSettings -> IO ()
+saveAppSettings db appSettings = do
+  DB.execute_ db "DELETE FROM app_settings"
+  DB.execute db "INSERT INTO app_settings (app_settings) VALUES (?)" (Only $ J.encode appSettings)
+
+getAppSettings :: DB.Connection -> Maybe AppSettings -> IO AppSettings
+getAppSettings db platformDefaults = do
+  stored_ <- join <$> liftIO (maybeFirstRow (J.decodeStrict . fromOnly) $ DB.query_ db "SELECT app_settings FROM app_settings")
+  pure $ combineAppSettings (fromMaybe defaultAppSettings platformDefaults) (fromMaybe defaultParseAppSettings stored_)

src/Simplex/Chat/Store/Migrations.hs

@@ -99,6 +99,7 @@ import Simplex.Chat.Migrations.M20240104_members_profile_update
 import Simplex.Chat.Migrations.M20240115_block_member_for_all
 import Simplex.Chat.Migrations.M20240122_indexes
 import Simplex.Chat.Migrations.M20240214_redirect_file_id
+import Simplex.Chat.Migrations.M20240222_app_settings
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -197,7 +198,8 @@ schemaMigrations =
     ("20240104_members_profile_update", m20240104_members_profile_update, Just down_m20240104_members_profile_update),
     ("20240115_block_member_for_all", m20240115_block_member_for_all, Just down_m20240115_block_member_for_all),
     ("20240122_indexes", m20240122_indexes, Just down_m20240122_indexes),
-    ("20240214_redirect_file_id", m20240214_redirect_file_id, Just down_m20240214_redirect_file_id)
+    ("20240214_redirect_file_id", m20240214_redirect_file_id, Just down_m20240214_redirect_file_id),
+    ("20240222_app_settings", m20240222_app_settings, Just down_m20240222_app_settings)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/View.hs

@@ -385,6 +385,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRChatError u e -> ttyUser' u $ viewChatError logLevel testView e
   CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError logLevel testView) errs
   CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
+  CRAppSettings as -> ["app settings: " <> plain (LB.unpack $ J.encode as)]
   CRTimedAction _ _ -> []
   where
     ttyUser :: User -> [StyledString] -> [StyledString]