core: support postgres backend (#5403)

* postgres: modules structure (#5401)

* postgres: schema, field conversions (#5430)

* postgres: rework chat list pagination query (#5441)

* prepare cabal for merge

* restore cabal changes

* simplexmq

* postgres: implementation wip (tests don't pass) (#5481)

* restore ios file

* postgres: implementation - tests pass (#5487)

* refactor DB options

* refactor

* line

* style

* style

* refactor

* $

* update simplexmq

* constraintError

* handleDBErrors

* fix

* remove param

* Ok

* case

* case

* case

* comment

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
spaced4ndy
2025-01-10 11:27:29 +00:00
committed by GitHub
co-authored by Evgeny Poberezkin
parent 13fae855fc
commit e05a35e26e
187 changed files with 2847 additions and 1291 deletions
+12 -7
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -8,19 +9,23 @@ module Simplex.Chat.Store.Remote where
import Control.Monad.Except
import Data.Int (Int64)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeASCII)
import Data.Text.Encoding (decodeASCII, encodeUtf8)
import Data.Word (Word16)
import Database.SQLite.Simple (Only (..))
import qualified Database.SQLite.Simple as SQL
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Remote.Types
import Simplex.Chat.Store.Shared
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String (StrEncoding (..))
import Simplex.RemoteControl.Types
import UnliftIO
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query)
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), Query)
import Database.SQLite.Simple.QQ (sql)
#endif
insertRemoteHost :: DB.Connection -> Text -> FilePath -> Maybe RCCtrlAddress -> Maybe Word16 -> RCHostPairing -> ExceptT StoreError IO RemoteHostId
insertRemoteHost db hostDeviceName storePath rcAddr_ bindPort_ RCHostPairing {caKey, caCert, idPrivKey, knownHost = kh_} = do
@@ -54,7 +59,7 @@ getRemoteHostByFingerprint db fingerprint =
maybeFirstRow toRemoteHost $
DB.query db (remoteHostQuery <> " WHERE host_fingerprint = ?") (Only fingerprint)
remoteHostQuery :: SQL.Query
remoteHostQuery :: Query
remoteHostQuery =
[sql|
SELECT remote_host_id, host_device_name, store_path, ca_key, ca_cert, id_key, host_fingerprint, host_dh_pub, bind_iface, bind_addr, bind_port
@@ -117,7 +122,7 @@ getRemoteCtrlByFingerprint db fingerprint =
maybeFirstRow toRemoteCtrl $
DB.query db (remoteCtrlQuery <> " WHERE ctrl_fingerprint = ?") (Only fingerprint)
remoteCtrlQuery :: SQL.Query
remoteCtrlQuery :: Query
remoteCtrlQuery =
[sql|
SELECT remote_ctrl_id, ctrl_device_name, ca_key, ca_cert, ctrl_fingerprint, id_pub, dh_priv_key, prev_dh_priv_key