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>

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