core: Mobile.hs postgres interface (#5545)

* core: Mobile.hs postgres interface

* sqlite

* fix

* errors

* postgres

* rename

* rename, refactor

* merge files

* rename

* update simplexmq

---------

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

cabal.project

@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: fdde9863cdc87dc47609a3a5f51a4c2c4c038858
+    tag: 488c7082f3b8cd1447e2e6f02bd913d2790f3c61
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."fdde9863cdc87dc47609a3a5f51a4c2c4c038858" = "00jx2zy7b8c8mav01h0ycj6qm5298pxhd960x0p1r1ram4a0nhww";
+  "https://github.com/simplex-chat/simplexmq.git"."488c7082f3b8cd1447e2e6f02bd913d2790f3c61" = "10x7byv49c5aj0c9ikvmnfsdi41czgffdwikizy339426b3mq4qx";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

simplex-chat.cabal

@@ -48,8 +48,10 @@ library
       Simplex.Chat.Messages.Batch
       Simplex.Chat.Messages.CIContent
       Simplex.Chat.Messages.CIContent.Events
+      Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared
+      Simplex.Chat.Mobile.WebRTC
       Simplex.Chat.Operators
       Simplex.Chat.Operators.Conditions
       Simplex.Chat.Options
@@ -96,8 +98,6 @@ library
   else
       exposed-modules:
           Simplex.Chat.Archive
-          Simplex.Chat.Mobile
-          Simplex.Chat.Mobile.WebRTC
           Simplex.Chat.Options.SQLite
           Simplex.Chat.Store.SQLite.Migrations
           Simplex.Chat.Store.SQLite.Migrations.M20220101_initial

src/Simplex/Chat.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -51,9 +50,6 @@ import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolType (..),
 import qualified Simplex.Messaging.TMap as TM
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
-#endif
 
 operatorSimpleXChat :: NewServerOperator
 operatorSimpleXChat =
@@ -188,19 +184,10 @@ logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 createChatDatabase :: ChatDbOpts -> MigrationConfirmation -> IO (Either MigrationError ChatDatabase)
-createChatDatabase dbOpts confirmMigrations = runExceptT $ do
-#if defined(dbPostgres)
-  let ChatDbOpts {dbName, dbUser, dbSchemaPrefix} = dbOpts
-      connectInfo = defaultConnectInfo {connectUser = dbUser, connectDatabase = dbName}
-  chatStore <- ExceptT $ createChatStore connectInfo (chatSchema dbSchemaPrefix) confirmMigrations
-  agentStore <- ExceptT $ createAgentStore connectInfo (agentSchema dbSchemaPrefix) confirmMigrations
+createChatDatabase chatDbOpts confirmMigrations = runExceptT $ do
+  chatStore <- ExceptT $ createChatStore (toDBOpts chatDbOpts chatSuffix False) confirmMigrations
+  agentStore <- ExceptT $ createAgentStore (toDBOpts chatDbOpts agentSuffix False) confirmMigrations
   pure ChatDatabase {chatStore, agentStore}
-#else
-  let ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration} = dbOpts
-  chatStore <- ExceptT $ createChatStore (chatStoreFile dbFilePrefix) dbKey False confirmMigrations vacuumOnMigration
-  agentStore <- ExceptT $ createAgentStore (agentStoreFile dbFilePrefix) dbKey False confirmMigrations vacuumOnMigration
-  pure ChatDatabase {chatStore, agentStore}
-#endif
 
 newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Bool -> IO ChatController
 newChatController

src/Simplex/Chat/Call.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
@@ -22,19 +21,13 @@ import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
+import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Chat.Types (Contact, ContactId, User)
 import Simplex.Messaging.Agent.Store.DB (Binary (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
 import Simplex.Messaging.Util (decodeJSON, encodeJSON)
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple.FromField (FromField (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-#else
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
-#endif
 
 data Call = Call
   { contactId :: ContactId,

src/Simplex/Chat/Library/Commands.hs

@@ -86,8 +86,8 @@ import Simplex.FileTransfer.Description (FileDescriptionURI (..), maxFileSize, m
 import Simplex.Messaging.Agent as Agent
 import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
 import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.Store.Interface (execSQL)
 import Simplex.Messaging.Agent.Store.Shared (upMigration)
-import Simplex.Messaging.Agent.Store (execSQL)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import qualified Simplex.Messaging.Agent.Store.Migrations as Migrations
 import Simplex.Messaging.Client (NetworkConfig (..), SocksMode (SMAlways), textToHostMode)

src/Simplex/Chat/Messages.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -43,6 +42,7 @@ import GHC.TypeLits (ErrorMessage (ShowType, type (:<>:)), TypeError)
 import qualified GHC.TypeLits as Type
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -54,13 +54,6 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, parseAll, sumTypeJSON)
 import Simplex.Messaging.Protocol (BlockingInfo, MsgBody)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple.FromField (FromField (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-#else
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
-#endif
 
 data ChatType = CTDirect | CTGroup | CTLocal | CTContactRequest | CTContactConnection
   deriving (Eq, Show, Ord)

src/Simplex/Chat/Messages/CIContent.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -25,6 +24,7 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Type.Equality
 import Data.Word (Word32)
 import Simplex.Chat.Messages.CIContent.Events
+import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -34,13 +34,6 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOff, pattern
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)
 import Simplex.Messaging.Util (encodeJSON, safeDecodeUtf8, tshow, (<$?>))
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple.FromField (FromField (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-#else
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
-#endif
 
 data MsgDirection = MDRcv | MDSnd
   deriving (Eq, Show)

src/Simplex/Chat/Mobile.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -16,7 +17,6 @@ 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
@@ -26,8 +26,6 @@ import Data.List (find)
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
 import Data.Word (Word8)
-import Database.SQLite.Simple (SQLError (..))
-import qualified Database.SQLite.Simple as DB
 import Foreign.C.String
 import Foreign.C.Types (CInt (..))
 import Foreign.Ptr
@@ -49,7 +47,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 (closeStore, reopenStore)
+import Simplex.Messaging.Agent.Store.Interface (closeDBStore, reopenDBStore)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -58,6 +56,10 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..)
 import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
 import System.IO (utf8)
 import System.Timeout (timeout)
+#if !defined(dbPostgres)
+import Database.SQLite.Simple (SQLError (..))
+import qualified Database.SQLite.Simple as DB
+#endif
 
 data DBMigrationResult
   = DBMOk
@@ -112,9 +114,11 @@ foreign export ccall "chat_encrypt_file" cChatEncryptFile :: StablePtr ChatContr
 foreign export ccall "chat_decrypt_file" cChatDecryptFile :: CString -> CString -> CString -> CString -> IO CString
 
 -- | check / migrate database and initialize chat controller on success
+-- For postgres first param is schema prefix, second param is database connection string.
 cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
 cChatMigrateInit fp key conf = cChatMigrateInitKey fp key 0 conf 0
 
+-- For postgres first param is schema prefix, second param is database connection string.
 cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> CInt -> Ptr (StablePtr ChatController) -> IO CJSONString
 cChatMigrateInitKey fp key keepKey conf background ctrl = do
   -- ensure we are set to UTF-8; iOS does not have locale, and will default to
@@ -123,11 +127,10 @@ cChatMigrateInitKey fp key keepKey conf background ctrl = do
   setFileSystemEncoding utf8
   setForeignEncoding utf8
 
-  dbPath <- peekCString fp
-  dbKey <- BA.convert <$> B.packCString key
+  chatDbOpts <- mobileDbOpts fp key
   confirm <- peekCAString conf
   r <-
-    chatMigrateInitKey dbPath dbKey (keepKey /= 0) confirm (background /= 0) >>= \case
+    chatMigrateInitKey chatDbOpts (keepKey /= 0) confirm (background /= 0) >>= \case
       Right cc -> (newStablePtr cc >>= poke ctrl) $> DBMOk
       Left e -> pure e
   newCStringFromLazyBS $ J.encode r
@@ -185,17 +188,12 @@ cChatValidName cName = newCString . mkValidName =<< peekCString cName
 cChatJsonLength :: CString -> IO CInt
 cChatJsonLength s = fromIntegral . subtract 2 . LB.length . J.encode . safeDecodeUtf8 <$> B.packCString s
 
-mobileChatOpts :: String -> ChatOpts
-mobileChatOpts dbFilePrefix =
+mobileChatOpts :: ChatDbOpts -> ChatOpts
+mobileChatOpts dbOptions =
   ChatOpts
     { coreOptions =
         CoreChatOpts
-          { dbOptions =
-              ChatDbOpts
-                { dbFilePrefix,
-                  dbKey = "", -- for API database is already opened, and the key in options is not used
-                  vacuumOnMigration = True
-                },
+          { dbOptions,
             smpServers = [],
             xftpServers = [],
             simpleNetCfg = defaultSimpleNetCfg,
@@ -235,40 +233,50 @@ defaultMobileConfig =
 getActiveUser_ :: DBStore -> IO (Maybe User)
 getActiveUser_ st = find activeUser <$> withTransaction st getUsers
 
+#if !defined(dbPostgres)
+-- only used in tests
 chatMigrateInit :: String -> ScrubbedBytes -> String -> IO (Either DBMigrationResult ChatController)
-chatMigrateInit dbFilePrefix dbKey confirm = chatMigrateInitKey dbFilePrefix dbKey False confirm False
+chatMigrateInit dbFilePrefix dbKey confirm = do
+  let chatDBOpts = ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration = True}
+  chatMigrateInitKey chatDBOpts False confirm False
+#endif
 
-chatMigrateInitKey :: String -> ScrubbedBytes -> Bool -> String -> Bool -> IO (Either DBMigrationResult ChatController)
-chatMigrateInitKey dbFilePrefix dbKey keepKey confirm backgroundMode = runExceptT $ do
+chatMigrateInitKey :: ChatDbOpts -> Bool -> String -> Bool -> IO (Either DBMigrationResult ChatController)
+chatMigrateInitKey chatDbOpts keepKey confirm backgroundMode = runExceptT $ do
   confirmMigrations <- liftEitherWith (const DBMInvalidConfirmation) $ strDecode $ B.pack confirm
-  chatStore <- migrate createChatStore (chatStoreFile dbFilePrefix) confirmMigrations
-  agentStore <- migrate createAgentStore (agentStoreFile dbFilePrefix) confirmMigrations
+  chatStore <- migrate createChatStore (toDBOpts chatDbOpts chatSuffix keepKey) confirmMigrations
+  agentStore <- migrate createAgentStore (toDBOpts chatDbOpts agentSuffix keepKey) confirmMigrations
   liftIO $ initialize chatStore ChatDatabase {chatStore, agentStore}
   where
-    opts = mobileChatOpts dbFilePrefix
+    opts = mobileChatOpts $ removeDbKey chatDbOpts
     initialize st db = do
       user_ <- getActiveUser_ st
       newChatController db user_ defaultMobileConfig opts backgroundMode
-    migrate createStore dbFile confirmMigrations =
+    migrate createStore dbOpts confirmMigrations =
       ExceptT $
-        (first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey keepKey confirmMigrations (vacuumOnMigration $ dbOptions $ coreOptions opts))
+        (first (DBMErrorMigration errDbStr) <$> createStore dbOpts confirmMigrations)
+#if !defined(dbPostgres)
           `catch` (pure . checkDBError)
+#endif
           `catchAll` (pure . dbError)
       where
+        errDbStr = errorDbStr dbOpts
+#if !defined(dbPostgres)
         checkDBError e = case sqlError e of
-          DB.ErrorNotADatabase -> Left $ DBMErrorNotADatabase dbFile
+          DB.ErrorNotADatabase -> Left $ DBMErrorNotADatabase errDbStr
           _ -> dbError e
-        dbError e = Left . DBMErrorSQL dbFile $ show e
+#endif
+        dbError e = Left . DBMErrorSQL errDbStr $ show e
 
 chatCloseStore :: ChatController -> IO String
 chatCloseStore ChatController {chatStore, smpAgent} = handleErr $ do
-  closeStore chatStore
-  closeStore $ agentClientStore smpAgent
+  closeDBStore chatStore
+  closeDBStore $ agentClientStore smpAgent
 
 chatReopenStore :: ChatController -> IO String
 chatReopenStore ChatController {chatStore, smpAgent} = handleErr $ do
-  reopenStore chatStore
-  reopenStore (agentClientStore smpAgent)
+  reopenDBStore chatStore
+  reopenDBStore (agentClientStore smpAgent)
 
 handleErr :: IO () -> IO String
 handleErr a = (a $> "") `catch` (pure . show @SomeException)

src/Simplex/Chat/Operators.hs

@@ -46,6 +46,7 @@ import Data.Time (addUTCTime)
 import Data.Time.Clock (UTCTime, nominalDay)
 import Language.Haskell.TH.Syntax (lift)
 import Simplex.Chat.Operators.Conditions
+import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Chat.Types (User)
 import Simplex.Chat.Types.Util (textParseJSON)
 import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
@@ -54,13 +55,6 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, sumTy
 import Simplex.Messaging.Protocol (AProtocolType (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, SProtocolType (..), UserProtocol)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (atomicModifyIORef'_, safeDecodeUtf8)
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple.FromField (FromField (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-#else
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
-#endif
 
 usageConditionsCommit :: Text
 usageConditionsCommit = "a5061f3147165a05979d6ace33960aced2d6ac03"

src/Simplex/Chat/Options/DB.hs

@@ -1,14 +1,25 @@
 {-# LANGUAGE CPP #-}
 
 module Simplex.Chat.Options.DB
+
 #if defined(dbPostgres)
   ( module Simplex.Chat.Options.Postgres,
+    FromField (..),
+    ToField (..),
   )
   where
 import Simplex.Chat.Options.Postgres
+import Database.PostgreSQL.Simple.FromField (FromField (..))
+import Database.PostgreSQL.Simple.ToField (ToField (..))
+
 #else
   ( module Simplex.Chat.Options.SQLite,
+    FromField (..),
+    ToField (..),
   )
   where
 import Simplex.Chat.Options.SQLite
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
+
 #endif

src/Simplex/Chat/Options/Postgres.hs

@@ -1,37 +1,68 @@
 {-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Chat.Options.Postgres where
 
+import qualified Data.ByteString.Char8 as B
+import Foreign.C.String
 import Options.Applicative
+import Simplex.Messaging.Agent.Store.Interface (DBOpts (..))
 
 data ChatDbOpts = ChatDbOpts
-  { dbName :: String,
-    dbUser :: String,
+  { dbConnstr :: String,
     dbSchemaPrefix :: String
   }
 
 chatDbOptsP :: FilePath -> String -> Parser ChatDbOpts
 chatDbOptsP _appDir defaultDbName = do
-  dbName <-
+  dbConnstr <-
     strOption
       ( long "database"
           <> short 'd'
-          <> metavar "DB_NAME"
-          <> help "Database name"
-          <> value defaultDbName
+          <> metavar "DB_CONN"
+          <> help "Database connection string"
+          <> value ("postgresql://simplex@/" <> defaultDbName)
           <> showDefault
       )
-  dbUser <-
+  dbSchemaPrefix <-
     strOption
-      ( long "database-user"
-          <> short 'u'
-          <> metavar "DB_USER"
-          <> help "Database user"
-          <> value "simplex"
+      ( long "schema-prefix"
+          <> metavar "DB_SCHEMA_PREFIX"
+          <> help "Database schema prefix"
+          <> value "simplex_v1"
           <> showDefault
       )
-  pure ChatDbOpts {dbName, dbUser, dbSchemaPrefix = ""}
+  pure ChatDbOpts {dbConnstr, dbSchemaPrefix}
 
 dbString :: ChatDbOpts -> String
-dbString ChatDbOpts {dbName} = dbName
+dbString ChatDbOpts {dbConnstr} = dbConnstr
+
+toDBOpts :: ChatDbOpts -> String -> Bool -> DBOpts
+toDBOpts ChatDbOpts {dbConnstr, dbSchemaPrefix} dbSuffix _keepKey =
+  DBOpts
+    { connstr = B.pack dbConnstr,
+      schema = if null dbSchemaPrefix then "simplex_v1" <> dbSuffix else dbSchemaPrefix <> dbSuffix
+    }
+
+chatSuffix :: String
+chatSuffix = "_chat_schema"
+
+agentSuffix :: String
+agentSuffix = "_agent_schema"
+
+mobileDbOpts :: CString -> CString -> IO ChatDbOpts
+mobileDbOpts schemaPrefix connstr = do
+  dbSchemaPrefix <- peekCString schemaPrefix
+  dbConnstr <- peekCString connstr
+  pure $
+    ChatDbOpts
+      { dbConnstr,
+        dbSchemaPrefix
+      }
+
+removeDbKey :: ChatDbOpts -> ChatDbOpts
+removeDbKey = id
+
+errorDbStr :: DBOpts -> String
+errorDbStr DBOpts {schema} = schema

src/Simplex/Chat/Options/SQLite.hs

@@ -1,11 +1,16 @@
 {-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Chat.Options.SQLite where
 
 import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString.Char8 as B
+import Foreign.C.String
 import Options.Applicative
+import Simplex.Messaging.Agent.Store.Interface (DBOpts (..))
 import System.FilePath (combine)
 
 data ChatDbOpts = ChatDbOpts
@@ -42,3 +47,42 @@ chatDbOptsP appDir defaultDbName = do
 
 dbString :: ChatDbOpts -> String
 dbString ChatDbOpts {dbFilePrefix} = dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
+
+toDBOpts :: ChatDbOpts -> String -> Bool -> DBOpts
+toDBOpts ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration} dbSuffix keepKey = do
+  DBOpts
+    { dbFilePath = dbFilePrefix <> dbSuffix,
+      dbKey,
+      keepKey,
+      vacuum = vacuumOnMigration
+    }
+
+chatSuffix :: String
+chatSuffix = "_chat.db"
+
+agentSuffix :: String
+agentSuffix = "_agent.db"
+
+mobileDbOpts :: CString -> CString -> IO ChatDbOpts
+mobileDbOpts fp key = do
+  dbFilePrefix <- peekCString fp
+  dbKey <- BA.convert <$> B.packCString key
+  pure $
+    ChatDbOpts
+      { dbFilePrefix,
+        dbKey,
+        vacuumOnMigration = True
+      }
+
+-- used to create new chat controller,
+-- at that point database is already opened, and the key in options is not used
+removeDbKey :: ChatDbOpts -> ChatDbOpts
+removeDbKey ChatDbOpts {dbFilePrefix, vacuumOnMigration} =
+  ChatDbOpts
+    { dbFilePrefix,
+      dbKey = "",
+      vacuumOnMigration
+    }
+
+errorDbStr :: DBOpts -> String
+errorDbStr DBOpts {dbFilePath} = dbFilePath

src/Simplex/Chat/Protocol.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
@@ -46,6 +45,7 @@ import Data.Type.Equality
 import Data.Typeable (Typeable)
 import Data.Word (Word32)
 import Simplex.Chat.Call
+import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
@@ -58,13 +58,6 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstTo
 import Simplex.Messaging.Protocol (MsgBody)
 import Simplex.Messaging.Util (decodeJSON, eitherToMaybe, encodeJSON, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version hiding (version)
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple.FromField (FromField (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-#else
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
-#endif
 
 -- Chat version history:
 -- 1 - support chat versions in connections (9/1/2023)

src/Simplex/Chat/Store.hs

@@ -9,13 +9,6 @@ module Simplex.Chat.Store
     AutoAccept (..),
     createChatStore,
     migrations, -- used in tests
-#if defined(dbPostgres)
-    chatSchema,
-    agentSchema,
-#else
-    chatStoreFile,
-    agentStoreFile,
-#endif
     withTransaction,
   )
 where
@@ -23,35 +16,13 @@ where
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Store.Shared
 import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
+import Simplex.Messaging.Agent.Store.Interface (DBOpts, createDBStore)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation, MigrationError)
 #if defined(dbPostgres)
-import Database.PostgreSQL.Simple (ConnectInfo (..))
 import Simplex.Chat.Store.Postgres.Migrations
-import Simplex.Messaging.Agent.Store.Postgres (createDBStore)
 #else
-import Data.ByteArray (ScrubbedBytes)
 import Simplex.Chat.Store.SQLite.Migrations
-import Simplex.Messaging.Agent.Store.SQLite (createDBStore)
 #endif
 
-#if defined(dbPostgres)
-createChatStore :: ConnectInfo -> String -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-createChatStore connectInfo schema = createDBStore connectInfo schema migrations
-
-chatSchema :: String -> String
-chatSchema "" = "chat_schema"
-chatSchema prefix = prefix <> "_chat_schema"
-
-agentSchema :: String -> String
-agentSchema "" = "agent_schema"
-agentSchema prefix = prefix <> "_agent_schema"
-#else
-createChatStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> Bool -> IO (Either MigrationError DBStore)
-createChatStore dbPath key keepKey = createDBStore dbPath key keepKey migrations
-
-chatStoreFile :: FilePath -> FilePath
-chatStoreFile = (<> "_chat.db")
-
-agentStoreFile :: FilePath -> FilePath
-agentStoreFile = (<> "_agent.db")
-#endif
+createChatStore :: DBOpts -> MigrationConfirmation -> IO (Either MigrationError DBStore)
+createChatStore dbCreateOpts = createDBStore dbCreateOpts migrations

src/Simplex/Chat/Types/Preferences.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -31,17 +30,11 @@ import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 import GHC.Records.Compat
+import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Chat.Types.Shared
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
 import Simplex.Messaging.Util (decodeJSON, encodeJSON, safeDecodeUtf8, (<$?>))
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple.FromField (FromField (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-#else
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
-#endif
 
 data ChatFeature
   = CFTimedMessages

src/Simplex/Chat/Types/Shared.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -7,16 +6,10 @@ module Simplex.Chat.Types.Shared where
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
+import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder)
 import Simplex.Messaging.Util ((<$?>))
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple.FromField (FromField (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-#else
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
-#endif
 
 data GroupMemberRole
   = GRObserver -- connects to all group members and receives all messages, can't send messages

src/Simplex/Chat/Types/UITheme.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -14,17 +13,11 @@ import qualified Data.Aeson.TH as JQ
 import Data.Char (toLower)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+import Simplex.Chat.Options.DB (FromField (..), ToField (..))
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_)
 import Simplex.Messaging.Util (decodeJSON, encodeJSON)
-#if defined(dbPostgres)
-import Database.PostgreSQL.Simple.FromField (FromField (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-#else
-import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple.ToField (ToField (..))
-#endif
 
 data UITheme = UITheme
   { themeId :: Text,

tests/ChatClient.hs

@@ -44,7 +44,7 @@ import Simplex.Messaging.Agent (disposeAgentClient)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol (currentSMPAgentVersion, duplexHandshakeSMPAgentVersion, pqdrSMPAgentVersion, supportedSMPAgentVRange)
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Agent.Store (closeStore)
+import Simplex.Messaging.Agent.Store.Interface (closeDBStore)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Client (ProtocolClientConfig (..))
@@ -72,17 +72,14 @@ import System.FilePath ((</>))
 #endif
 
 #if defined(dbPostgres)
-testDBName :: String
-testDBName = "test_chat_db"
-
-testDBUser :: String
-testDBUser = "test_chat_user"
+testDBConnstr :: String
+testDBConnstr = "postgresql://test_chat_user@/test_chat_db"
 
 testDBConnectInfo :: ConnectInfo
 testDBConnectInfo =
   defaultConnectInfo {
-    connectUser = testDBUser,
-    connectDatabase = testDBName
+    connectUser = "test_chat_user",
+    connectDatabase = "test_chat_db"
   }
 #endif
 
@@ -114,8 +111,7 @@ testCoreOpts =
     {
       dbOptions = ChatDbOpts
 #if defined(dbPostgres)
-        { dbName = testDBName,
-          dbUser = testDBUser,
+        { dbConnstr = testDBConnstr,
           -- dbSchemaPrefix is not used in tests (except bot tests where it's redefined),
           -- instead different schema prefix is passed per client so that single test database is used
           dbSchemaPrefix = ""
@@ -323,7 +319,7 @@ stopTestChat TestCC {chatController = cc@ChatController {smpAgent, chatStore}, c
   uninterruptibleCancel termAsync
   uninterruptibleCancel chatAsync
   liftIO $ disposeAgentClient smpAgent
-  closeStore chatStore
+  closeDBStore chatStore
   threadDelay 200000
 
 withNewTestChat :: HasCallStack => FilePath -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a

tests/ChatTests/Direct.hs

@@ -28,6 +28,7 @@ import Simplex.Chat.Call
 import Simplex.Chat.Controller (ChatConfig (..), PresetServers (..))
 import Simplex.Chat.Messages (ChatItemId)
 import Simplex.Chat.Options
+import Simplex.Chat.Options.DB
 import Simplex.Chat.Protocol (supportedChatVRange)
 import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, pattern VersionChat)
 import Simplex.Messaging.Agent.Env.SQLite
@@ -44,7 +45,6 @@ import Test.Hspec hiding (it)
 import Database.PostgreSQL.Simple (Only (..))
 #else
 import Database.SQLite.Simple (Only (..))
-import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
 import System.FilePath ((</>))
 #endif
 
@@ -2793,8 +2793,8 @@ setupDesynchronizedRatchet tmp alice = do
     (alice </)
   where
     copyDb from to = do
-      copyFile (chatStoreFile $ tmp </> from) (chatStoreFile $ tmp </> to)
-      copyFile (agentStoreFile $ tmp </> from) (agentStoreFile $ tmp </> to)
+      copyFile (tmp </> (from <> chatSuffix)) (tmp </> (to <> chatSuffix))
+      copyFile (tmp </> (from <> agentSuffix)) (tmp </> (to <> agentSuffix))
 
 testSyncRatchet :: HasCallStack => FilePath -> IO ()
 testSyncRatchet tmp =

tests/ChatTests/Groups.hs

@@ -20,6 +20,7 @@ import qualified Data.Text as T
 import Simplex.Chat.Controller (ChatConfig (..))
 import Simplex.Chat.Messages (ChatItemId)
 import Simplex.Chat.Options
+import Simplex.Chat.Options.DB
 import Simplex.Chat.Protocol (supportedChatVRange)
 import Simplex.Chat.Types (VersionRangeChat)
 import Simplex.Chat.Types.Shared (GroupMemberRole (..))
@@ -33,7 +34,6 @@ import Test.Hspec hiding (it)
 import Database.PostgreSQL.Simple (Only (..))
 #else
 import Database.SQLite.Simple (Only (..))
-import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
 import System.Directory (copyFile)
 import System.FilePath ((</>))
 #endif
@@ -3606,8 +3606,8 @@ setupDesynchronizedRatchet tmp alice = do
     bob <# "#team alice> decryption error, possibly due to the device change (header, 3 messages)"
   where
     copyDb from to = do
-      copyFile (chatStoreFile $ tmp </> from) (chatStoreFile $ tmp </> to)
-      copyFile (agentStoreFile $ tmp </> from) (agentStoreFile $ tmp </> to)
+      copyFile (tmp </> (from <> chatSuffix)) (tmp </> (to <> chatSuffix))
+      copyFile (tmp </> (from <> agentSuffix)) (tmp </> (to <> agentSuffix))
 
 testGroupSyncRatchet :: HasCallStack => FilePath -> IO ()
 testGroupSyncRatchet tmp =

tests/MobileTests.hs

@@ -32,9 +32,11 @@ import Simplex.Chat.Mobile
 import Simplex.Chat.Mobile.File
 import Simplex.Chat.Mobile.Shared
 import Simplex.Chat.Mobile.WebRTC
+import Simplex.Chat.Options.DB
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Types (AgentUserId (..), Profile (..))
+import Simplex.Messaging.Agent.Store.Interface
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile(..), CryptoFileArgs (..))
@@ -157,8 +159,8 @@ testChatApiNoUser tmp = do
 testChatApi :: FilePath -> IO ()
 testChatApi tmp = do
   let dbPrefix = tmp </> "1"
-      f = chatStoreFile dbPrefix
-  Right st <- createChatStore f "myKey" False MCYesUp True
+      f = dbPrefix <> chatSuffix
+  Right st <- createChatStore (DBOpts f "myKey" False True) MCYesUp
   Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True
   Right cc <- chatMigrateInit dbPrefix "myKey" "yesUp"
   Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" "yesUp"

tests/SchemaDump.hs

@@ -10,8 +10,8 @@ import Data.List (dropWhileEnd)
 import Data.Maybe (fromJust, isJust)
 import Simplex.Chat.Store (createChatStore)
 import qualified Simplex.Chat.Store as Store
+import Simplex.Messaging.Agent.Store.Interface
 import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
-import Simplex.Messaging.Agent.Store.SQLite (closeDBStore, createDBStore)
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Util (ifM, whenM)
 import System.Directory (doesFileExist, removeFile)
@@ -53,7 +53,7 @@ testVerifySchemaDump :: IO ()
 testVerifySchemaDump = withTmpFiles $ do
   savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
   savedSchema `deepseq` pure ()
-  void $ createChatStore testDB "" False MCError True
+  void $ createChatStore (DBOpts testDB "" False True) MCError
   getSchema testDB appSchema `shouldReturn` savedSchema
   removeFile testDB
 
@@ -61,14 +61,14 @@ testVerifyLintFKeyIndexes :: IO ()
 testVerifyLintFKeyIndexes = withTmpFiles $ do
   savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
   savedLint `deepseq` pure ()
-  void $ createChatStore testDB "" False MCError True
+  void $ createChatStore (DBOpts testDB "" False True) MCError
   getLintFKeyIndexes testDB "tests/tmp/chat_lint.sql" `shouldReturn` savedLint
   removeFile testDB
 
 testSchemaMigrations :: IO ()
 testSchemaMigrations = withTmpFiles $ do
   let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations
-  Right st <- createDBStore testDB "" False noDownMigrations MCError True
+  Right st <- createDBStore (DBOpts testDB "" False True) noDownMigrations MCError
   mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
   closeDBStore st
   removeFile testDB