lovely-projects/simplex-chat
lovely-projects/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-03-14 09:45:42 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

core: support postgres backend (#5403)

Browse source 
* 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 15:27:29 +04:00 • committed by GitHub
parent 13fae855fc
commit e05a35e26e
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
187 changed files with 2847 additions and 1291 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
apps/simplex-bot-advanced/Main.hs
View file

@ -31,9 +31,9 @@ main = do
welcomeGetOpts :: IO ChatOpts
welcomeGetOpts = do
appDir <- getAppUserDataDirectory "simplex"
opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getChatOpts appDir "simplex_bot"
opts@ChatOpts {coreOptions} <- getChatOpts appDir "simplex_bot"
putStrLn $ "SimpleX Chat Bot v" ++ versionNumber
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
printDbOpts coreOptions
pure opts
welcomeMessage :: Text

4
apps/simplex-bot/Main.hs
View file

@ -25,7 +25,7 @@ welcomeMessage = "Hello! I am a simple squaring bot.\nIf you send me a number, I
welcomeGetOpts :: IO ChatOpts
welcomeGetOpts = do
appDir <- getAppUserDataDirectory "simplex"
opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getChatOpts appDir "simplex_bot"
opts@ChatOpts {coreOptions} <- getChatOpts appDir "simplex_bot"
putStrLn $ "SimpleX Chat Bot v" ++ versionNumber
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
printDbOpts coreOptions
pure opts

4
apps/simplex-broadcast-bot/src/Broadcast/Bot.hs
View file

@ -27,9 +27,9 @@ import System.Directory (getAppUserDataDirectory)
welcomeGetOpts :: IO BroadcastBotOpts
welcomeGetOpts = do
appDir <- getAppUserDataDirectory "simplex"
opts@BroadcastBotOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getBroadcastBotOpts appDir "simplex_status_bot"
opts@BroadcastBotOpts {coreOptions} <- getBroadcastBotOpts appDir "simplex_status_bot"
putStrLn $ "SimpleX Chat Bot v" ++ versionNumber
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
printDbOpts coreOptions
pure opts
broadcastBot :: BroadcastBotOpts -> User -> ChatController -> IO ()

8
apps/simplex-broadcast-bot/src/Broadcast/Options.hs
View file

@ -27,8 +27,8 @@ defaultProhibitedMessage :: [KnownContact] -> Text
defaultProhibitedMessage ps = "Sorry, only these users can broadcast messages: " <> knownContactNames ps <> ". Your message is deleted."
broadcastBotOpts :: FilePath -> FilePath -> Parser BroadcastBotOpts
broadcastBotOpts appDir defaultDbFileName = do
coreOptions <- coreChatOptsP appDir defaultDbFileName
broadcastBotOpts appDir defaultDbName = do
coreOptions <- coreChatOptsP appDir defaultDbName
publishers <-
option
parseKnownContacts
@ -61,10 +61,10 @@ broadcastBotOpts appDir defaultDbFileName = do
}
getBroadcastBotOpts :: FilePath -> FilePath -> IO BroadcastBotOpts
getBroadcastBotOpts appDir defaultDbFileName =
getBroadcastBotOpts appDir defaultDbName =
execParser $
info
(helper <*> versionOption <*> broadcastBotOpts appDir defaultDbFileName)
(helper <*> versionOption <*> broadcastBotOpts appDir defaultDbName)
(header versionStr <> fullDesc <> progDesc "Start chat bot with DB_FILE file and use SERVER as SMP server")
where
versionStr = versionString versionNumber

10
apps/simplex-directory-service/src/Directory/Options.hs
View file

@ -15,7 +15,7 @@ import qualified Data.Text as T
import Options.Applicative
import Simplex.Chat.Bot.KnownContacts
import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
import Simplex.Chat.Options (ChatOpts (..), ChatCmdLog (..), CoreChatOpts, coreChatOptsP)
import Simplex.Chat.Options (ChatCmdLog (..), ChatOpts (..), CoreChatOpts, coreChatOptsP)
data DirectoryOpts = DirectoryOpts
{ coreOptions :: CoreChatOpts,
@ -29,8 +29,8 @@ data DirectoryOpts = DirectoryOpts
}
directoryOpts :: FilePath -> FilePath -> Parser DirectoryOpts
directoryOpts appDir defaultDbFileName = do
coreOptions <- coreChatOptsP appDir defaultDbFileName
directoryOpts appDir defaultDbName = do
coreOptions <- coreChatOptsP appDir defaultDbName
adminUsers <-
option
parseKnownContacts
@ -77,10 +77,10 @@ directoryOpts appDir defaultDbFileName = do
}
getDirectoryOpts :: FilePath -> FilePath -> IO DirectoryOpts
getDirectoryOpts appDir defaultDbFileName =
getDirectoryOpts appDir defaultDbName =
execParser $
info
(helper <*> versionOption <*> directoryOpts appDir defaultDbFileName)
(helper <*> versionOption <*> directoryOpts appDir defaultDbName)
(header versionStr <> fullDesc <> progDesc "Start SimpleX Directory Service with DB_FILE, DIRECTORY_FILE and SUPER_USERS options")
where
versionStr = versionString versionNumber

4
apps/simplex-directory-service/src/Directory/Service.hs
View file

@ -74,10 +74,10 @@ newServiceState = do
welcomeGetOpts :: IO DirectoryOpts
welcomeGetOpts = do
appDir <- getAppUserDataDirectory "simplex"
opts@DirectoryOpts {coreOptions = CoreChatOpts {dbFilePrefix}, testing} <- getDirectoryOpts appDir "simplex_directory_service"
opts@DirectoryOpts {coreOptions, testing} <- getDirectoryOpts appDir "simplex_directory_service"
unless testing $ do
putStrLn $ "SimpleX Directory Service Bot v" ++ versionNumber
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
printDbOpts coreOptions
pure opts
directoryServiceCLI :: DirectoryStore -> DirectoryOpts -> IO ()

2
cabal.project
View file

@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 992b42e92224ec663684923aaa40ed1f9a683f61
tag: 9d9ec8cd0b171b2058c59c4e7292ccafa96b6e2b
source-repository-package
type: git

2
scripts/nix/sha256map.nix
View file

@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."992b42e92224ec663684923aaa40ed1f9a683f61" = "08bhkqm2hvgql63hrayas7izvxbv99pdzwvn3kj6z0j02pnwng6d";
"https://github.com/simplex-chat/simplexmq.git"."9d9ec8cd0b171b2058c59c4e7292ccafa96b6e2b" = "0mvg9yrwb835vf2kz8k0ac4i7vzjpvbpcwg895n3kcfdkdcnxh14";
"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";

299
simplex-chat.cabal
View file

@ -24,11 +24,15 @@ flag swift
manual: True
default: False
flag client_postgres
description: Build with PostgreSQL instead of SQLite.
manual: True
default: False
library
exposed-modules:
Simplex.Chat
Simplex.Chat.AppSettings
Simplex.Chat.Archive
Simplex.Chat.Bot
Simplex.Chat.Bot.KnownContacts
Simplex.Chat.Call
@ -44,132 +48,12 @@ library
Simplex.Chat.Messages.Batch
Simplex.Chat.Messages.CIContent
Simplex.Chat.Messages.CIContent.Events
Simplex.Chat.Migrations.M20220101_initial
Simplex.Chat.Migrations.M20220122_v1_1
Simplex.Chat.Migrations.M20220205_chat_item_status
Simplex.Chat.Migrations.M20220210_deduplicate_contact_requests
Simplex.Chat.Migrations.M20220224_messages_fks
Simplex.Chat.Migrations.M20220301_smp_servers
Simplex.Chat.Migrations.M20220302_profile_images
Simplex.Chat.Migrations.M20220304_msg_quotes
Simplex.Chat.Migrations.M20220321_chat_item_edited
Simplex.Chat.Migrations.M20220404_files_status_fields
Simplex.Chat.Migrations.M20220514_profiles_user_id
Simplex.Chat.Migrations.M20220626_auto_reply
Simplex.Chat.Migrations.M20220702_calls
Simplex.Chat.Migrations.M20220715_groups_chat_item_id
Simplex.Chat.Migrations.M20220811_chat_items_indices
Simplex.Chat.Migrations.M20220812_incognito_profiles
Simplex.Chat.Migrations.M20220818_chat_notifications
Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id
Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items
Simplex.Chat.Migrations.M20220824_profiles_local_alias
Simplex.Chat.Migrations.M20220909_commands
Simplex.Chat.Migrations.M20220926_connection_alias
Simplex.Chat.Migrations.M20220928_settings
Simplex.Chat.Migrations.M20221001_shared_msg_id_indices
Simplex.Chat.Migrations.M20221003_delete_broken_integrity_error_chat_items
Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
Simplex.Chat.Migrations.M20221012_inline_files
Simplex.Chat.Migrations.M20221019_unread_chat
Simplex.Chat.Migrations.M20221021_auto_accept__group_links
Simplex.Chat.Migrations.M20221024_contact_used
Simplex.Chat.Migrations.M20221025_chat_settings
Simplex.Chat.Migrations.M20221029_group_link_id
Simplex.Chat.Migrations.M20221112_server_password
Simplex.Chat.Migrations.M20221115_server_cfg
Simplex.Chat.Migrations.M20221129_delete_group_feature_items
Simplex.Chat.Migrations.M20221130_delete_item_deleted
Simplex.Chat.Migrations.M20221209_verified_connection
Simplex.Chat.Migrations.M20221210_idxs
Simplex.Chat.Migrations.M20221211_group_description
Simplex.Chat.Migrations.M20221212_chat_items_timed
Simplex.Chat.Migrations.M20221214_live_message
Simplex.Chat.Migrations.M20221222_chat_ts
Simplex.Chat.Migrations.M20221223_idx_chat_items_item_status
Simplex.Chat.Migrations.M20221230_idxs
Simplex.Chat.Migrations.M20230107_connections_auth_err_counter
Simplex.Chat.Migrations.M20230111_users_agent_user_id
Simplex.Chat.Migrations.M20230117_fkey_indexes
Simplex.Chat.Migrations.M20230118_recreate_smp_servers
Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
Simplex.Chat.Migrations.M20230303_group_link_role
Simplex.Chat.Migrations.M20230317_hidden_profiles
Simplex.Chat.Migrations.M20230318_file_description
Simplex.Chat.Migrations.M20230321_agent_file_deleted
Simplex.Chat.Migrations.M20230328_files_protocol
Simplex.Chat.Migrations.M20230402_protocol_servers
Simplex.Chat.Migrations.M20230411_extra_xftp_file_descriptions
Simplex.Chat.Migrations.M20230420_rcv_files_to_receive
Simplex.Chat.Migrations.M20230422_profile_contact_links
Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
Simplex.Chat.Migrations.M20230505_chat_item_versions
Simplex.Chat.Migrations.M20230511_reactions
Simplex.Chat.Migrations.M20230519_item_deleted_ts
Simplex.Chat.Migrations.M20230526_indexes
Simplex.Chat.Migrations.M20230529_indexes
Simplex.Chat.Migrations.M20230608_deleted_contacts
Simplex.Chat.Migrations.M20230618_favorite_chats
Simplex.Chat.Migrations.M20230621_chat_item_moderations
Simplex.Chat.Migrations.M20230705_delivery_receipts
Simplex.Chat.Migrations.M20230721_group_snd_item_statuses
Simplex.Chat.Migrations.M20230814_indexes
Simplex.Chat.Migrations.M20230827_file_encryption
Simplex.Chat.Migrations.M20230829_connections_chat_vrange
Simplex.Chat.Migrations.M20230903_connections_to_subscribe
Simplex.Chat.Migrations.M20230913_member_contacts
Simplex.Chat.Migrations.M20230914_member_probes
Simplex.Chat.Migrations.M20230926_contact_status
Simplex.Chat.Migrations.M20231002_conn_initiated
Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
Simplex.Chat.Migrations.M20231010_member_settings
Simplex.Chat.Migrations.M20231019_indexes
Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
Simplex.Chat.Migrations.M20231107_indexes
Simplex.Chat.Migrations.M20231113_group_forward
Simplex.Chat.Migrations.M20231114_remote_control
Simplex.Chat.Migrations.M20231126_remote_ctrl_address
Simplex.Chat.Migrations.M20231207_chat_list_pagination
Simplex.Chat.Migrations.M20231214_item_content_tag
Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
Simplex.Chat.Migrations.M20240102_note_folders
Simplex.Chat.Migrations.M20240104_members_profile_update
Simplex.Chat.Migrations.M20240115_block_member_for_all
Simplex.Chat.Migrations.M20240122_indexes
Simplex.Chat.Migrations.M20240214_redirect_file_id
Simplex.Chat.Migrations.M20240222_app_settings
Simplex.Chat.Migrations.M20240226_users_restrict
Simplex.Chat.Migrations.M20240228_pq
Simplex.Chat.Migrations.M20240313_drop_agent_ack_cmd_id
Simplex.Chat.Migrations.M20240324_custom_data
Simplex.Chat.Migrations.M20240402_item_forwarded
Simplex.Chat.Migrations.M20240430_ui_theme
Simplex.Chat.Migrations.M20240501_chat_deleted
Simplex.Chat.Migrations.M20240510_chat_items_via_proxy
Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays
Simplex.Chat.Migrations.M20240528_quota_err_counter
Simplex.Chat.Migrations.M20240827_calls_uuid
Simplex.Chat.Migrations.M20240920_user_order
Simplex.Chat.Migrations.M20241008_indexes
Simplex.Chat.Migrations.M20241010_contact_requests_contact_id
Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id
Simplex.Chat.Migrations.M20241027_server_operators
Simplex.Chat.Migrations.M20241125_indexes
Simplex.Chat.Migrations.M20241128_business_chats
Simplex.Chat.Migrations.M20241205_business_chat_members
Simplex.Chat.Migrations.M20241222_operator_conditions
Simplex.Chat.Migrations.M20241223_chat_tags
Simplex.Chat.Migrations.M20241230_reports
Simplex.Chat.Migrations.M20250105_indexes
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
Simplex.Chat.Options.DB
Simplex.Chat.ProfileGenerator
Simplex.Chat.Protocol
Simplex.Chat.Remote
@ -187,7 +71,6 @@ library
Simplex.Chat.Store.Files
Simplex.Chat.Store.Groups
Simplex.Chat.Store.Messages
Simplex.Chat.Store.Migrations
Simplex.Chat.Store.NoteFolders
Simplex.Chat.Store.Profiles
Simplex.Chat.Store.Remote
@ -205,6 +88,137 @@ library
Simplex.Chat.Types.Util
Simplex.Chat.Util
Simplex.Chat.View
if flag(client_postgres)
exposed-modules:
Simplex.Chat.Options.Postgres
Simplex.Chat.Store.Postgres.Migrations
Simplex.Chat.Store.Postgres.Migrations.M20241220_initial
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
Simplex.Chat.Store.SQLite.Migrations.M20220122_v1_1
Simplex.Chat.Store.SQLite.Migrations.M20220205_chat_item_status
Simplex.Chat.Store.SQLite.Migrations.M20220210_deduplicate_contact_requests
Simplex.Chat.Store.SQLite.Migrations.M20220224_messages_fks
Simplex.Chat.Store.SQLite.Migrations.M20220301_smp_servers
Simplex.Chat.Store.SQLite.Migrations.M20220302_profile_images
Simplex.Chat.Store.SQLite.Migrations.M20220304_msg_quotes
Simplex.Chat.Store.SQLite.Migrations.M20220321_chat_item_edited
Simplex.Chat.Store.SQLite.Migrations.M20220404_files_status_fields
Simplex.Chat.Store.SQLite.Migrations.M20220514_profiles_user_id
Simplex.Chat.Store.SQLite.Migrations.M20220626_auto_reply
Simplex.Chat.Store.SQLite.Migrations.M20220702_calls
Simplex.Chat.Store.SQLite.Migrations.M20220715_groups_chat_item_id
Simplex.Chat.Store.SQLite.Migrations.M20220811_chat_items_indices
Simplex.Chat.Store.SQLite.Migrations.M20220812_incognito_profiles
Simplex.Chat.Store.SQLite.Migrations.M20220818_chat_notifications
Simplex.Chat.Store.SQLite.Migrations.M20220822_groups_host_conn_custom_user_profile_id
Simplex.Chat.Store.SQLite.Migrations.M20220823_delete_broken_group_event_chat_items
Simplex.Chat.Store.SQLite.Migrations.M20220824_profiles_local_alias
Simplex.Chat.Store.SQLite.Migrations.M20220909_commands
Simplex.Chat.Store.SQLite.Migrations.M20220926_connection_alias
Simplex.Chat.Store.SQLite.Migrations.M20220928_settings
Simplex.Chat.Store.SQLite.Migrations.M20221001_shared_msg_id_indices
Simplex.Chat.Store.SQLite.Migrations.M20221003_delete_broken_integrity_error_chat_items
Simplex.Chat.Store.SQLite.Migrations.M20221004_idx_msg_deliveries_message_id
Simplex.Chat.Store.SQLite.Migrations.M20221011_user_contact_links_group_id
Simplex.Chat.Store.SQLite.Migrations.M20221012_inline_files
Simplex.Chat.Store.SQLite.Migrations.M20221019_unread_chat
Simplex.Chat.Store.SQLite.Migrations.M20221021_auto_accept__group_links
Simplex.Chat.Store.SQLite.Migrations.M20221024_contact_used
Simplex.Chat.Store.SQLite.Migrations.M20221025_chat_settings
Simplex.Chat.Store.SQLite.Migrations.M20221029_group_link_id
Simplex.Chat.Store.SQLite.Migrations.M20221112_server_password
Simplex.Chat.Store.SQLite.Migrations.M20221115_server_cfg
Simplex.Chat.Store.SQLite.Migrations.M20221129_delete_group_feature_items
Simplex.Chat.Store.SQLite.Migrations.M20221130_delete_item_deleted
Simplex.Chat.Store.SQLite.Migrations.M20221209_verified_connection
Simplex.Chat.Store.SQLite.Migrations.M20221210_idxs
Simplex.Chat.Store.SQLite.Migrations.M20221211_group_description
Simplex.Chat.Store.SQLite.Migrations.M20221212_chat_items_timed
Simplex.Chat.Store.SQLite.Migrations.M20221214_live_message
Simplex.Chat.Store.SQLite.Migrations.M20221222_chat_ts
Simplex.Chat.Store.SQLite.Migrations.M20221223_idx_chat_items_item_status
Simplex.Chat.Store.SQLite.Migrations.M20221230_idxs
Simplex.Chat.Store.SQLite.Migrations.M20230107_connections_auth_err_counter
Simplex.Chat.Store.SQLite.Migrations.M20230111_users_agent_user_id
Simplex.Chat.Store.SQLite.Migrations.M20230117_fkey_indexes
Simplex.Chat.Store.SQLite.Migrations.M20230118_recreate_smp_servers
Simplex.Chat.Store.SQLite.Migrations.M20230129_drop_chat_items_group_idx
Simplex.Chat.Store.SQLite.Migrations.M20230206_item_deleted_by_group_member_id
Simplex.Chat.Store.SQLite.Migrations.M20230303_group_link_role
Simplex.Chat.Store.SQLite.Migrations.M20230317_hidden_profiles
Simplex.Chat.Store.SQLite.Migrations.M20230318_file_description
Simplex.Chat.Store.SQLite.Migrations.M20230321_agent_file_deleted
Simplex.Chat.Store.SQLite.Migrations.M20230328_files_protocol
Simplex.Chat.Store.SQLite.Migrations.M20230402_protocol_servers
Simplex.Chat.Store.SQLite.Migrations.M20230411_extra_xftp_file_descriptions
Simplex.Chat.Store.SQLite.Migrations.M20230420_rcv_files_to_receive
Simplex.Chat.Store.SQLite.Migrations.M20230422_profile_contact_links
Simplex.Chat.Store.SQLite.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
Simplex.Chat.Store.SQLite.Migrations.M20230505_chat_item_versions
Simplex.Chat.Store.SQLite.Migrations.M20230511_reactions
Simplex.Chat.Store.SQLite.Migrations.M20230519_item_deleted_ts
Simplex.Chat.Store.SQLite.Migrations.M20230526_indexes
Simplex.Chat.Store.SQLite.Migrations.M20230529_indexes
Simplex.Chat.Store.SQLite.Migrations.M20230608_deleted_contacts
Simplex.Chat.Store.SQLite.Migrations.M20230618_favorite_chats
Simplex.Chat.Store.SQLite.Migrations.M20230621_chat_item_moderations
Simplex.Chat.Store.SQLite.Migrations.M20230705_delivery_receipts
Simplex.Chat.Store.SQLite.Migrations.M20230721_group_snd_item_statuses
Simplex.Chat.Store.SQLite.Migrations.M20230814_indexes
Simplex.Chat.Store.SQLite.Migrations.M20230827_file_encryption
Simplex.Chat.Store.SQLite.Migrations.M20230829_connections_chat_vrange
Simplex.Chat.Store.SQLite.Migrations.M20230903_connections_to_subscribe
Simplex.Chat.Store.SQLite.Migrations.M20230913_member_contacts
Simplex.Chat.Store.SQLite.Migrations.M20230914_member_probes
Simplex.Chat.Store.SQLite.Migrations.M20230926_contact_status
Simplex.Chat.Store.SQLite.Migrations.M20231002_conn_initiated
Simplex.Chat.Store.SQLite.Migrations.M20231009_via_group_link_uri_hash
Simplex.Chat.Store.SQLite.Migrations.M20231010_member_settings
Simplex.Chat.Store.SQLite.Migrations.M20231019_indexes
Simplex.Chat.Store.SQLite.Migrations.M20231030_xgrplinkmem_received
Simplex.Chat.Store.SQLite.Migrations.M20231107_indexes
Simplex.Chat.Store.SQLite.Migrations.M20231113_group_forward
Simplex.Chat.Store.SQLite.Migrations.M20231114_remote_control
Simplex.Chat.Store.SQLite.Migrations.M20231126_remote_ctrl_address
Simplex.Chat.Store.SQLite.Migrations.M20231207_chat_list_pagination
Simplex.Chat.Store.SQLite.Migrations.M20231214_item_content_tag
Simplex.Chat.Store.SQLite.Migrations.M20231215_recreate_msg_deliveries
Simplex.Chat.Store.SQLite.Migrations.M20240102_note_folders
Simplex.Chat.Store.SQLite.Migrations.M20240104_members_profile_update
Simplex.Chat.Store.SQLite.Migrations.M20240115_block_member_for_all
Simplex.Chat.Store.SQLite.Migrations.M20240122_indexes
Simplex.Chat.Store.SQLite.Migrations.M20240214_redirect_file_id
Simplex.Chat.Store.SQLite.Migrations.M20240222_app_settings
Simplex.Chat.Store.SQLite.Migrations.M20240226_users_restrict
Simplex.Chat.Store.SQLite.Migrations.M20240228_pq
Simplex.Chat.Store.SQLite.Migrations.M20240313_drop_agent_ack_cmd_id
Simplex.Chat.Store.SQLite.Migrations.M20240324_custom_data
Simplex.Chat.Store.SQLite.Migrations.M20240402_item_forwarded
Simplex.Chat.Store.SQLite.Migrations.M20240430_ui_theme
Simplex.Chat.Store.SQLite.Migrations.M20240501_chat_deleted
Simplex.Chat.Store.SQLite.Migrations.M20240510_chat_items_via_proxy
Simplex.Chat.Store.SQLite.Migrations.M20240515_rcv_files_user_approved_relays
Simplex.Chat.Store.SQLite.Migrations.M20240528_quota_err_counter
Simplex.Chat.Store.SQLite.Migrations.M20240827_calls_uuid
Simplex.Chat.Store.SQLite.Migrations.M20240920_user_order
Simplex.Chat.Store.SQLite.Migrations.M20241008_indexes
Simplex.Chat.Store.SQLite.Migrations.M20241010_contact_requests_contact_id
Simplex.Chat.Store.SQLite.Migrations.M20241023_chat_item_autoincrement_id
Simplex.Chat.Store.SQLite.Migrations.M20241027_server_operators
Simplex.Chat.Store.SQLite.Migrations.M20241125_indexes
Simplex.Chat.Store.SQLite.Migrations.M20241128_business_chats
Simplex.Chat.Store.SQLite.Migrations.M20241205_business_chat_members
Simplex.Chat.Store.SQLite.Migrations.M20241222_operator_conditions
Simplex.Chat.Store.SQLite.Migrations.M20241223_chat_tags
Simplex.Chat.Store.SQLite.Migrations.M20241230_reports
Simplex.Chat.Store.SQLite.Migrations.M20250105_indexes
other-modules:
Paths_simplex_chat
hs-source-dirs:
@ -224,7 +238,6 @@ library
, containers ==0.6.*
, crypton ==0.34.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, email-validate ==2.3.*
, exceptions ==0.10.*
@ -243,7 +256,6 @@ library
, simple-logger ==0.1.*
, simplexmq >=6.3
, socks ==0.6.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.12.*
@ -255,6 +267,16 @@ library
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
if flag(client_postgres)
build-depends:
postgresql-libpq >=0.10.0.0
, postgresql-simple ==0.7.*
, raw-strings-qq ==1.1.*
cpp-options: -DdbPostgres
else
build-depends:
direct-sqlcipher ==2.3.*
, sqlcipher-simple ==0.4.*
if impl(ghc >= 9.6.2)
build-depends:
bytestring ==0.11.*
@ -282,6 +304,8 @@ executable simplex-bot
, directory ==1.3.*
, simplex-chat
default-language: Haskell2010
if flag(client_postgres)
cpp-options: -DdbPostgres
executable simplex-bot-advanced
main-is: Main.hs
@ -300,6 +324,8 @@ executable simplex-bot-advanced
, simplexmq >=6.3
, stm ==2.5.*
default-language: Haskell2010
if flag(client_postgres)
cpp-options: -DdbPostgres
if impl(ghc >= 9.6.2)
build-depends:
text >=2.0.1 && <2.2
@ -328,6 +354,8 @@ executable simplex-broadcast-bot
, simplexmq >=6.3
, stm ==2.5.*
default-language: Haskell2010
if flag(client_postgres)
cpp-options: -DdbPostgres
if impl(ghc >= 9.6.2)
build-depends:
text >=2.0.1 && <2.2
@ -357,6 +385,8 @@ executable simplex-chat
, unliftio ==0.2.*
, websockets ==0.12.*
default-language: Haskell2010
if flag(client_postgres)
cpp-options: -DdbPostgres
if impl(ghc >= 9.6.2)
build-depends:
text >=2.0.1 && <2.2
@ -393,6 +423,8 @@ executable simplex-directory-service
, stm ==2.5.*
, time ==1.12.*
default-language: Haskell2010
if flag(client_postgres)
cpp-options: -DdbPostgres
if impl(ghc >= 9.6.2)
build-depends:
bytestring ==0.11.*
@ -418,18 +450,16 @@ test-suite simplex-chat-test
ChatTests.Local
ChatTests.Profiles
ChatTests.Utils
JSONFixtures
JSONTests
MarkdownTests
MessageBatching
MobileTests
OperatorTests
ProtocolTests
RandomServers
RemoteTests
SchemaDump
ValidNames
ViewTests
WebRTCTests
Broadcast.Bot
Broadcast.Options
Directory.Events
@ -438,6 +468,11 @@ test-suite simplex-chat-test
Directory.Service
Directory.Store
Paths_simplex_chat
if !flag(client_postgres)
other-modules:
MobileTests
SchemaDump
WebRTCTests
hs-source-dirs:
tests
apps/simplex-broadcast-bot/src
@ -469,12 +504,18 @@ test-suite simplex-chat-test
, simple-logger ==0.1.*
, simplex-chat
, simplexmq >=6.3
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.12.*
, unliftio ==0.2.*
default-language: Haskell2010
if flag(client_postgres)
build-depends:
postgresql-simple ==0.7.*
cpp-options: -DdbPostgres
else
build-depends:
sqlcipher-simple ==0.4.*
if impl(ghc >= 9.6.2)
build-depends:
bytestring ==0.11.*

25
src/Simplex/Chat.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
@ -20,7 +21,6 @@ import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Unlift
import Data.Bifunctor (bimap, second)
import Data.ByteArray (ScrubbedBytes)
import Data.List (partition, sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
@ -32,6 +32,7 @@ import Simplex.Chat.Controller
import Simplex.Chat.Library.Commands
import Simplex.Chat.Operators
import Simplex.Chat.Options
import Simplex.Chat.Options.DB
import Simplex.Chat.Protocol
import Simplex.Chat.Store
import Simplex.Chat.Store.Profiles
@ -42,7 +43,7 @@ import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), ServerCfg (..), ServerRoles (..), allRoles, createAgentStore, defaultAgentConfig, presetServerCfg)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store.Common (DBStore (dbNew))
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError)
import Simplex.Messaging.Client (defaultNetworkConfig)
import qualified Simplex.Messaging.Crypto as C
@ -50,6 +51,9 @@ 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 =
@ -183,11 +187,20 @@ fluxXFTPServers =
logCfg :: LogConfig
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
createChatDatabase :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> Bool -> IO (Either MigrationError ChatDatabase)
createChatDatabase filePrefix key keepKey confirmMigrations vacuum = runExceptT $ do
chatStore <- ExceptT $ createChatStore (chatStoreFile filePrefix) key keepKey confirmMigrations vacuum
agentStore <- ExceptT $ createAgentStore (agentStoreFile filePrefix) key keepKey confirmMigrations vacuum
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
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

3
src/Simplex/Chat/Archive.hs
View file

@ -11,7 +11,6 @@ module Simplex.Chat.Archive
deleteStorage,
sqlCipherExport,
sqlCipherTestKey,
archiveFilesFolder,
)
where
@ -112,7 +111,7 @@ copyValidDirectoryFiles isFileError fromDir toDir = do
Nothing ->
(copyDirectoryFile f $> fileErrs)
`E.catch` \(e :: E.SomeException) -> addErr $ show e
Just e -> addErr e
Just e -> addErr e
where
addErr e = pure $ AEFileError f e : fileErrs
copyDirectoryFile f = do

21
src/Simplex/Chat/Call.hs
View file

@ -1,9 +1,13 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
@ -18,13 +22,19 @@ import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (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,
@ -90,6 +100,9 @@ data CallState
newtype CallId = CallId ByteString
deriving (Eq, Show)
deriving newtype (FromField)
instance ToField CallId where toField (CallId m) = toField $ Binary m
instance StrEncoding CallId where
strEncode (CallId m) = strEncode m
@ -103,10 +116,6 @@ instance ToJSON CallId where
toJSON = strToJSON
toEncoding = strToJEncoding
instance FromField CallId where fromField f = CallId <$> fromField f
instance ToField CallId where toField (CallId m) = toField m
data RcvCallInvitation = RcvCallInvitation
{ user :: User,
contact :: Contact,

46
src/Simplex/Chat/Controller.hs
View file

@ -46,8 +46,6 @@ import Data.Time (NominalDiffTime, UTCTime)
import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
import Data.Version (showVersion)
import Data.Word (Word16)
import Database.SQLite.Simple (SQLError)
import qualified Database.SQLite.Simple as SQL
import Language.Haskell.TH (Exp, Q, runIO)
import Numeric.Natural
import qualified Paths_simplex_chat as SC
@ -73,10 +71,9 @@ import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWo
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, ServerCfg)
import Simplex.Messaging.Agent.Lock
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store.SQLite.Common (DBStore, withTransaction, withTransactionPriority)
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction, withTransactionPriority)
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation, UpMigration)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Client (HostMode (..), SMPProxyFallback (..), SMPProxyMode (..), SocksMode (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..))
@ -97,6 +94,11 @@ import System.IO (Handle)
import System.Mem.Weak (Weak)
import qualified UnliftIO.Exception as E
import UnliftIO.STM
#if !defined(dbPostgres)
import Database.SQLite.Simple (SQLError)
import qualified Database.SQLite.Simple as SQL
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
#endif
versionNumber :: String
versionNumber = showVersion SC.version
@ -284,17 +286,19 @@ data ChatCommand
| APISetAppFilePaths AppFilePathsConfig
| APISetEncryptLocalFiles Bool
| SetContactMergeEnabled Bool
#if !defined(dbPostgres)
| APIExportArchive ArchiveConfig
| ExportArchive
| APIImportArchive ArchiveConfig
| APISaveAppSettings AppSettings
| APIGetAppSettings (Maybe AppSettings)
| APIDeleteStorage
| APIStorageEncryption DBEncryptionConfig
| TestStorageEncryption DBEncryptionKey
| SlowSQLQueries
#endif
| ExecChatStoreSQL Text
| ExecAgentStoreSQL Text
| SlowSQLQueries
| APISaveAppSettings AppSettings
| APIGetAppSettings (Maybe AppSettings)
| APIGetChatTags UserId
| APIGetChats {userId :: UserId, pendingConnections :: Bool, pagination :: PaginationByTime, query :: ChatListQuery}
| APIGetChat ChatRef (Maybe ContentFilter) ChatPagination (Maybe String)
@ -559,11 +563,14 @@ allowRemoteCommand = \case
SetFilesFolder _ -> False
SetRemoteHostsFolder _ -> False
APISetEncryptLocalFiles _ -> False
#if !defined(dbPostgres)
APIExportArchive _ -> False
APIImportArchive _ -> False
ExportArchive -> False
APIDeleteStorage -> False
APIStorageEncryption _ -> False
SlowSQLQueries -> False
#endif
APISetNetworkConfig _ -> False
APIGetNetworkConfig -> False
SetLocalDeviceName _ -> False
@ -583,7 +590,6 @@ allowRemoteCommand = \case
DeleteRemoteCtrl _ -> False
ExecChatStoreSQL _ -> False
ExecAgentStoreSQL _ -> False
SlowSQLQueries -> False
_ -> True
data ChatResponse
@ -798,7 +804,11 @@ data ChatResponse
| CRRemoteCtrlStopped {rcsState :: RemoteCtrlSessionState, rcStopReason :: RemoteCtrlStopReason}
| CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption}
| CRSQLResult {rows :: [Text]}
#if !defined(dbPostgres)
| CRArchiveExported {archiveErrors :: [ArchiveError]}
| CRArchiveImported {archiveErrors :: [ArchiveError]}
| CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
#endif
| CRDebugLocks {chatLockName :: Maybe String, chatEntityLocks :: Map String String, agentLocks :: AgentLocks}
| CRAgentSubsTotal {user :: User, subsTotal :: SMPServerSubs, hasSession :: Bool}
| CRAgentServersSummary {user :: User, serversSummary :: PresentedServersSummary}
@ -817,8 +827,6 @@ data ChatResponse
| CRChatCmdError {user_ :: Maybe User, chatError :: ChatError}
| CRChatError {user_ :: Maybe User, chatError :: ChatError}
| CRChatErrors {user_ :: Maybe User, chatErrors :: [ChatError]}
| CRArchiveExported {archiveErrors :: [ArchiveError]}
| CRArchiveImported {archiveErrors :: [ArchiveError]}
| CRAppSettings {appSettings :: AppSettings}
| CRTimedAction {action :: String, durationMilliseconds :: Int64}
| CRCustomChatResponse {user_ :: Maybe User, response :: Text}
@ -846,7 +854,9 @@ allowRemoteEvent = \case
CRRemoteCtrlConnected _ -> False
CRRemoteCtrlStopped {} -> False
CRSQLResult _ -> False
#if !defined(dbPostgres)
CRSlowSQLQueries {} -> False
#endif
_ -> True
logResponseToFile :: ChatResponse -> Bool
@ -1181,11 +1191,13 @@ data CoreVersionInfo = CoreVersionInfo
}
deriving (Show)
#if !defined(dbPostgres)
data SlowSQLQuery = SlowSQLQuery
{ query :: Text,
queryStats :: SlowQueryStats
}
deriving (Show)
#endif
data ChatError
= ChatError {errorType :: ChatErrorType}
@ -1512,13 +1524,17 @@ withStoreBatch actions = do
ChatController {chatStore} <- ask
liftIO $ withTransaction chatStore $ mapM (`E.catches` handleDBErrors) . actions
-- TODO [postgres] postgres specific error handling
handleDBErrors :: [E.Handler IO (Either ChatError a)]
handleDBErrors =
[ E.Handler $ \(e :: SQLError) ->
#if !defined(dbPostgres)
( E.Handler $ \(e :: SQLError) ->
let se = SQL.sqlError e
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e,
E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e
in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e
) :
#endif
[ E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e
]
withStoreBatch' :: Traversable t => (DB.Connection -> t (IO a)) -> CM' (t (Either ChatError a))
@ -1591,7 +1607,9 @@ $(JQ.deriveJSON defaultJSON ''ChatItemDeletion)
$(JQ.deriveJSON defaultJSON ''CoreVersionInfo)
#if !defined(dbPostgres)
$(JQ.deriveJSON defaultJSON ''SlowSQLQuery)
#endif
-- instance ProtocolTypeI p => FromJSON (ProtoServersConfig p) where
-- parseJSON = $(JQ.mkParseJSON defaultJSON ''ProtoServersConfig)

6
src/Simplex/Chat/Core.hs
View file

@ -26,22 +26,22 @@ import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Types
import Simplex.Chat.View (serializeChatResponse)
import Simplex.Messaging.Agent.Store.SQLite.Common (DBStore (..), withTransaction)
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
import System.Exit (exitFailure)
import System.IO (hFlush, stdout)
import Text.Read (readMaybe)
import UnliftIO.Async
simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent, yesToUpMigrations, vacuumOnMigration}} chat =
simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbOptions, logAgent, yesToUpMigrations}} chat =
case logAgent of
Just level -> do
setLogLevel level
withGlobalLogging logCfg initRun
_ -> initRun
where
initRun = createChatDatabase dbFilePrefix dbKey False confirm' vacuumOnMigration >>= either exit run
initRun = createChatDatabase dbOptions confirm' >>= either exit run
confirm' = if confirmMigrations == MCConsole && yesToUpMigrations then MCYesUp else confirmMigrations
exit e = do
putStrLn $ "Error opening database: " <> show e

47
src/Simplex/Chat/Library/Commands.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
@ -26,8 +27,6 @@ import Control.Monad.Reader
import qualified Data.Aeson as J
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (bimap, first, second)
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
@ -47,14 +46,11 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMayb
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
import Data.Time.Clock (UTCTime, getCurrentTime, nominalDay)
import Data.Type.Equality
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as V4
import qualified Database.SQLite.Simple as SQL
import Simplex.Chat.Library.Subscriber
import Simplex.Chat.Archive
import Simplex.Chat.Call
import Simplex.Chat.Controller
import Simplex.Chat.Files
@ -87,15 +83,12 @@ import Simplex.Chat.Util (liftIOEither)
import qualified Simplex.Chat.Util as U
import Simplex.FileTransfer.Description (FileDescriptionURI (..), maxFileSize, maxFileSizeHard)
import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Client (SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary)
import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store.SQLite (execSQL)
import Simplex.Messaging.Agent.Store.SQLite.Common (withConnection)
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
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)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
@ -122,6 +115,20 @@ import UnliftIO.Directory
import qualified UnliftIO.Exception as E
import UnliftIO.IO (hClose)
import UnliftIO.STM
#if defined(dbPostgres)
import Data.Bifunctor (bimap, second)
import Data.Time (NominalDiffTime, addUTCTime)
import Simplex.Messaging.Agent.Client (SubInfo (..), getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary)
#else
import Data.Bifunctor (bimap, first, second)
import qualified Data.ByteArray as BA
import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
import qualified Database.SQLite.Simple as SQL
import Simplex.Chat.Archive
import Simplex.Messaging.Agent.Client (SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary)
import Simplex.Messaging.Agent.Store.Common (withConnection)
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
#endif
_defaultNtfServers :: [NtfServer]
_defaultNtfServers =
@ -446,6 +453,7 @@ processChatCommand' vr = \case
chatWriteVar sel $ Just f
APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_
SetContactMergeEnabled onOff -> chatWriteVar contactMergeEnabled onOff >> ok_
#if !defined(dbPostgres)
APIExportArchive cfg -> checkChatStopped $ CRArchiveExported <$> lift (exportArchive cfg)
ExportArchive -> do
ts <- liftIO getCurrentTime
@ -455,13 +463,9 @@ processChatCommand' vr = \case
fileErrs <- lift $ importArchive cfg
setStoreChanged
pure $ CRArchiveImported fileErrs
APISaveAppSettings as -> withFastStore' (`saveAppSettings` as) >> ok_
APIGetAppSettings platformDefaults -> CRAppSettings <$> withFastStore' (`getAppSettings` platformDefaults)
APIDeleteStorage -> withStoreChanged deleteStorage
APIStorageEncryption cfg -> withStoreChanged $ sqlCipherExport cfg
TestStorageEncryption key -> sqlCipherTestKey key >> ok_
ExecChatStoreSQL query -> CRSQLResult <$> withStore' (`execSQL` query)
ExecAgentStoreSQL query -> CRSQLResult <$> withAgent (`execAgentStoreSQL` query)
SlowSQLQueries -> do
ChatController {chatStore, smpAgent} <- ask
chatQueries <- slowQueries chatStore
@ -474,6 +478,11 @@ processChatCommand' vr = \case
. sortOn (timeAvg . snd)
. M.assocs
<$> withConnection st (readTVarIO . DB.slow)
#endif
ExecChatStoreSQL query -> CRSQLResult <$> withStore' (`execSQL` query)
ExecAgentStoreSQL query -> CRSQLResult <$> withAgent (`execAgentStoreSQL` query)
APISaveAppSettings as -> withFastStore' (`saveAppSettings` as) >> ok_
APIGetAppSettings platformDefaults -> CRAppSettings <$> withFastStore' (`getAppSettings` platformDefaults)
APIGetChatTags userId -> withUserId' userId $ \user -> do
tags <- withFastStore' (`getUserChatTags` user)
pure $ CRChatTags user tags
@ -2421,12 +2430,14 @@ processChatCommand' vr = \case
| name == "" -> withFastStore (`getUserNoteFolderId` user)
| otherwise -> throwChatError $ CECommandError "not supported"
_ -> throwChatError $ CECommandError "not supported"
#if !defined(dbPostgres)
checkChatStopped :: CM ChatResponse -> CM ChatResponse
checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped)
setStoreChanged :: CM ()
setStoreChanged = asks chatStoreChanged >>= atomically . (`writeTVar` True)
withStoreChanged :: CM () -> CM ChatResponse
withStoreChanged a = checkChatStopped $ a >> setStoreChanged >> ok_
#endif
checkStoreNotChanged :: CM ChatResponse -> CM ChatResponse
checkStoreNotChanged = ifM (asks chatStoreChanged >>= readTVarIO) (throwChatError CEChatStoreChanged)
withUserName :: UserName -> (UserId -> ChatCommand) -> CM ChatResponse
@ -3558,6 +3569,7 @@ chatCommandP =
"/set file paths " *> (APISetAppFilePaths <$> jsonP),
"/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP),
"/contact_merge " *> (SetContactMergeEnabled <$> onOffP),
#if !defined(dbPostgres)
"/_db export " *> (APIExportArchive <$> jsonP),
"/db export" $> ExportArchive,
"/_db import " *> (APIImportArchive <$> jsonP),
@ -3567,11 +3579,12 @@ chatCommandP =
"/db key " *> (APIStorageEncryption <$> (dbEncryptionConfig <$> dbKeyP <* A.space <*> dbKeyP)),
"/db decrypt " *> (APIStorageEncryption . (`dbEncryptionConfig` "") <$> dbKeyP),
"/db test key " *> (TestStorageEncryption <$> dbKeyP),
"/sql slow" $> SlowSQLQueries,
#endif
"/_save app settings" *> (APISaveAppSettings <$> jsonP),
"/_get app settings" *> (APIGetAppSettings <$> optional (A.space *> jsonP)),
"/sql chat " *> (ExecChatStoreSQL <$> textP),
"/sql agent " *> (ExecAgentStoreSQL <$> textP),
"/sql slow" $> SlowSQLQueries,
"/_get tags " *> (APIGetChatTags <$> A.decimal),
"/_get chats "
*> ( APIGetChats
@ -4005,9 +4018,11 @@ chatCommandP =
logTLSErrors <- " log=" *> onOffP <|> pure False
let tcpTimeout_ = (1000000 *) <$> t_
pure $ SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, smpWebPort, tcpTimeout_, logTLSErrors}
#if !defined(dbPostgres)
dbKeyP = nonEmptyKey <$?> strP
nonEmptyKey k@(DBEncryptionKey s) = if BA.null s then Left "empty key" else Right k
dbEncryptionConfig currentKey newKey = DBEncryptionConfig {currentKey, newKey, keepKey = Just False}
#endif
autoAcceptP = ifM onOffP (Just <$> (businessAA <|> addressAA)) (pure Nothing)
where
addressAA = AutoAccept False <$> (" incognito=" *> onOffP <|> pure False) <*> autoReply

2
src/Simplex/Chat/Library/Internal.hs
View file

@ -79,7 +79,7 @@ import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..))
import Simplex.Messaging.Agent.Lock (withLock)
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Client (NetworkConfig (..))
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF

4
src/Simplex/Chat/Library/Subscriber.hs
View file

@ -43,12 +43,12 @@ import qualified Data.UUID.V4 as V4
import Data.Word (Word32)
import Simplex.Chat.Call
import Simplex.Chat.Controller
import Simplex.Chat.Library.Internal
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Messages.CIContent.Events
import Simplex.Chat.ProfileGenerator (generateRandomProfile)
import Simplex.Chat.Protocol
import Simplex.Chat.Library.Internal
import Simplex.Chat.Store
import Simplex.Chat.Store.Connections
import Simplex.Chat.Store.Direct
@ -70,7 +70,7 @@ import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Client (ProxyClientError (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..))

10
src/Simplex/Chat/Messages.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
@ -38,8 +39,6 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, nominalDay)
import Data.Type.Equality
import Data.Typeable (Typeable)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import GHC.TypeLits (ErrorMessage (ShowType, type (:<>:)), TypeError)
import qualified GHC.TypeLits as Type
import Simplex.Chat.Markdown
@ -55,6 +54,13 @@ import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, parseAll, sumTypeJSON)
import Simplex.Messaging.Protocol (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)

10
src/Simplex/Chat/Messages/CIContent.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
@ -23,8 +24,6 @@ import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Type.Equality
import Data.Word (Word32)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Chat.Messages.CIContent.Events
import Simplex.Chat.Protocol
import Simplex.Chat.Types
@ -35,6 +34,13 @@ 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)

14
src/Simplex/Chat/Mobile.hs
View file

@ -42,6 +42,7 @@ import Simplex.Chat.Mobile.File
import Simplex.Chat.Mobile.Shared
import Simplex.Chat.Mobile.WebRTC
import Simplex.Chat.Options
import Simplex.Chat.Options.DB
import Simplex.Chat.Remote.Types
import Simplex.Chat.Store
import Simplex.Chat.Store.Profiles
@ -189,8 +190,12 @@ mobileChatOpts dbFilePrefix =
ChatOpts
{ coreOptions =
CoreChatOpts
{ dbFilePrefix,
dbKey = "", -- for API database is already opened, and the key in options is not used
{ dbOptions =
ChatDbOpts
{ dbFilePrefix,
dbKey = "", -- for API database is already opened, and the key in options is not used
vacuumOnMigration = True
},
smpServers = [],
xftpServers = [],
simpleNetCfg = defaultSimpleNetCfg,
@ -201,8 +206,7 @@ mobileChatOpts dbFilePrefix =
logFile = Nothing,
tbqSize = 1024,
highlyAvailable = False,
yesToUpMigrations = False,
vacuumOnMigration = True
yesToUpMigrations = False
},
deviceName = Nothing,
chatCmd = "",
@ -247,7 +251,7 @@ chatMigrateInitKey dbFilePrefix dbKey keepKey confirm backgroundMode = runExcept
newChatController db user_ defaultMobileConfig opts backgroundMode
migrate createStore dbFile confirmMigrations =
ExceptT $
(first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey keepKey confirmMigrations (vacuumOnMigration $ coreOptions opts))
(first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey keepKey confirmMigrations (vacuumOnMigration $ dbOptions $ coreOptions opts))
`catch` (pure . checkDBError)
`catchAll` (pure . dbError)
where

25
src/Simplex/Chat/Operators.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
@ -43,8 +44,6 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (addUTCTime)
import Data.Time.Clock (UTCTime, nominalDay)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Language.Haskell.TH.Syntax (lift)
import Simplex.Chat.Operators.Conditions
import Simplex.Chat.Types (User)
@ -55,6 +54,13 @@ 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"
@ -119,7 +125,14 @@ instance TextEncoding OperatorTag where
-- this and other types only define instances of serialization for known DB IDs only,
-- entities without IDs cannot be serialized to JSON
instance FromField DBEntityId where fromField f = DBEntityId <$> fromField f
instance FromField DBEntityId
#if defined(dbPostgres)
where
fromField f dat = DBEntityId <$> fromField f dat
#else
where
fromField f = DBEntityId <$> fromField f
#endif
instance ToField DBEntityId where toField (DBEntityId i) = toField i
@ -338,7 +351,7 @@ updatedServerOperators presetOps storedOps =
<> map (\op -> (Nothing, Just $ ASO SDBStored op)) (filter (isNothing . operatorTag) storedOps)
where
-- TODO remove domains of preset operators from custom
addPreset op = ((Just op, storedOp' <$> pOperator op) :)
addPreset op = ((Just op, storedOp' <$> pOperator op) :)
where
storedOp' presetOp = case find ((operatorTag presetOp ==) . operatorTag) storedOps of
Just ServerOperator {operatorId, conditionsAcceptance, enabled, smpRoles, xftpRoles} ->
@ -427,7 +440,7 @@ groupByOperator_ (ops, smpSrvs, xftpSrvs) = do
where
mkUS op = UserOperatorServers op [] []
addServer :: [([Text], IORef (f UserOperatorServers))] -> IORef (f UserOperatorServers) -> (UserServer p -> UserOperatorServers -> UserOperatorServers) -> UserServer p -> IO ()
addServer ss custom add srv =
addServer ss custom add srv =
let v = maybe custom snd $ find (\(ds, _) -> any (\d -> any (matchingHost d) (srvHost srv)) ds) ss
in atomicModifyIORef'_ v (add srv <$>)
addSMP srv s@UserOperatorServers {smpServers} = (s :: UserOperatorServers) {smpServers = srv : smpServers}
@ -445,7 +458,7 @@ validateUserServers curr others = currUserErrs <> concatMap otherUserErrs others
where
currUserErrs = noServersErrs SPSMP Nothing curr <> noServersErrs SPXFTP Nothing curr <> serverErrs SPSMP curr <> serverErrs SPXFTP curr
otherUserErrs (user, uss) = noServersErrs SPSMP (Just user) uss <> noServersErrs SPXFTP (Just user) uss
noServersErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> Maybe User -> [u] -> [UserServersError]
noServersErrs :: (UserServersClass u, ProtocolTypeI p, UserProtocol p) => SProtocolType p -> Maybe User -> [u] -> [UserServersError]
noServersErrs p user uss
| noServers opEnabled = [USENoServers p' user]
| otherwise = [USEStorageMissing p' user | noServers (hasRole storage)] <> [USEProxyMissing p' user | noServers (hasRole proxy)]

53
src/Simplex/Chat/Options.hs
View file

@ -14,12 +14,12 @@ module Simplex.Chat.Options
getChatOpts,
protocolServersP,
defaultHostMode,
printDbOpts,
)
where
import Control.Logger.Simple (LogLevel (..))
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromMaybe)
import Data.Text (Text)
@ -34,7 +34,7 @@ import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI, SMPServerWithAuth, XFTPServerWithAuth)
import Simplex.Messaging.Transport.Client (SocksProxyWithAuth (..), SocksAuth (..), defaultSocksProxyWithAuth)
import System.FilePath (combine)
import Simplex.Chat.Options.DB
data ChatOpts = ChatOpts
{ coreOptions :: CoreChatOpts,
@ -54,8 +54,7 @@ data ChatOpts = ChatOpts
}
data CoreChatOpts = CoreChatOpts
{ dbFilePrefix :: String,
dbKey :: ScrubbedBytes,
{ dbOptions :: ChatDbOpts,
smpServers :: [SMPServerWithAuth],
xftpServers :: [XFTPServerWithAuth],
simpleNetCfg :: SimpleNetCfg,
@ -66,8 +65,7 @@ data CoreChatOpts = CoreChatOpts
logFile :: Maybe FilePath,
tbqSize :: Natural,
highlyAvailable :: Bool,
yesToUpMigrations :: Bool,
vacuumOnMigration :: Bool
yesToUpMigrations :: Bool
}
data ChatCmdLog = CCLAll | CCLMessages | CCLNone
@ -82,24 +80,8 @@ agentLogLevel = \case
CLLImportant -> LogInfo
coreChatOptsP :: FilePath -> FilePath -> Parser CoreChatOpts
coreChatOptsP appDir defaultDbFileName = do
dbFilePrefix <-
strOption
( long "database"
<> short 'd'
<> metavar "DB_FILE"
<> help "Path prefix to chat and agent database files"
<> value defaultDbFilePath
<> showDefault
)
dbKey <-
strOption
( long "key"
<> short 'k'
<> metavar "KEY"
<> help "Database encryption key/pass-phrase"
<> value ""
)
coreChatOptsP appDir defaultDbName = do
dbOptions <- chatDbOptsP appDir defaultDbName
smpServers <-
option
parseProtocolServers
@ -241,15 +223,9 @@ coreChatOptsP appDir defaultDbFileName = do
<> short 'y'
<> help "Automatically confirm \"up\" database migrations"
)
disableVacuum <-
switch
( long "disable-vacuum"
<> help "Do not vacuum database after migrations"
)
pure
CoreChatOpts
{ dbFilePrefix,
dbKey,
{ dbOptions,
smpServers,
xftpServers,
simpleNetCfg =
@ -271,12 +247,10 @@ coreChatOptsP appDir defaultDbFileName = do
logFile,
tbqSize,
highlyAvailable,
yesToUpMigrations,
vacuumOnMigration = not disableVacuum
yesToUpMigrations
}
where
useTcpTimeout p t = 1000000 * if t > 0 then t else maybe 7 (const 15) p
defaultDbFilePath = combine appDir defaultDbFileName
defaultHostMode :: Maybe SocksProxyWithAuth -> HostMode
defaultHostMode = \case
@ -284,8 +258,8 @@ defaultHostMode = \case
_ -> HMPublic
chatOptsP :: FilePath -> FilePath -> Parser ChatOpts
chatOptsP appDir defaultDbFileName = do
coreOptions <- coreChatOptsP appDir defaultDbFileName
chatOptsP appDir defaultDbName = do
coreOptions <- coreChatOptsP appDir defaultDbName
deviceName <-
optional $
strOption
@ -432,12 +406,15 @@ parseChatCmdLog = eitherReader $ \case
_ -> Left "Invalid chat command log level"
getChatOpts :: FilePath -> FilePath -> IO ChatOpts
getChatOpts appDir defaultDbFileName =
getChatOpts appDir defaultDbName =
execParser $
info
(helper <*> versionOption <*> chatOptsP appDir defaultDbFileName)
(helper <*> versionOption <*> chatOptsP appDir defaultDbName)
(header versionStr <> fullDesc <> progDesc "Start chat with DB_FILE file and use SERVER as SMP server")
where
versionStr = versionString versionNumber
versionOption = infoOption versionAndUpdate (long "version" <> short 'v' <> help "Show version")
versionAndUpdate = versionStr <> "\n" <> updateStr
printDbOpts :: CoreChatOpts -> IO ()
printDbOpts opts = putStrLn $ "db: " <> dbString (dbOptions opts)

14
src/Simplex/Chat/Options/DB.hs Normal file
View file

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

37
src/Simplex/Chat/Options/Postgres.hs Normal file
View file

@ -0,0 +1,37 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE NamedFieldPuns #-}
module Simplex.Chat.Options.Postgres where
import Options.Applicative
data ChatDbOpts = ChatDbOpts
{ dbName :: String,
dbUser :: String,
dbSchemaPrefix :: String
}
chatDbOptsP :: FilePath -> String -> Parser ChatDbOpts
chatDbOptsP _appDir defaultDbName = do
dbName <-
strOption
( long "database"
<> short 'd'
<> metavar "DB_NAME"
<> help "Database name"
<> value defaultDbName
<> showDefault
)
dbUser <-
strOption
( long "database-user"
<> short 'u'
<> metavar "DB_USER"
<> help "Database user"
<> value "simplex"
<> showDefault
)
pure ChatDbOpts {dbName, dbUser, dbSchemaPrefix = ""}
dbString :: ChatDbOpts -> String
dbString ChatDbOpts {dbName} = dbName

44
src/Simplex/Chat/Options/SQLite.hs Normal file
View file

@ -0,0 +1,44 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Options.SQLite where
import Data.ByteArray (ScrubbedBytes)
import Options.Applicative
import System.FilePath (combine)
data ChatDbOpts = ChatDbOpts
{ dbFilePrefix :: String,
dbKey :: ScrubbedBytes,
vacuumOnMigration :: Bool
}
chatDbOptsP :: FilePath -> FilePath -> Parser ChatDbOpts
chatDbOptsP appDir defaultDbName = do
dbFilePrefix <-
strOption
( long "database"
<> short 'd'
<> metavar "DB_FILE"
<> help "Path prefix to chat and agent database files"
<> value (combine appDir defaultDbName)
<> showDefault
)
dbKey <-
strOption
( long "key"
<> short 'k'
<> metavar "KEY"
<> help "Database encryption key/pass-phrase"
<> value ""
)
disableVacuum <-
switch
( long "disable-vacuum"
<> help "Do not vacuum database after migrations"
)
pure ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration = not disableVacuum}
dbString :: ChatDbOpts -> String
dbString ChatDbOpts {dbFilePrefix} = dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"

32
src/Simplex/Chat/Protocol.hs
View file

@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@ -42,21 +45,26 @@ import Data.Time.Clock (UTCTime)
import Data.Type.Equality
import Data.Typeable (Typeable)
import Data.Word (Word32)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Chat.Call
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.Util
import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Compression (Compressed, compress1, decompress1)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
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)
@ -217,10 +225,9 @@ instance StrEncoding AppMessageBinary where
newtype SharedMsgId = SharedMsgId ByteString
deriving (Eq, Show)
deriving newtype (FromField)
instance FromField SharedMsgId where fromField f = SharedMsgId <$> fromField f
instance ToField SharedMsgId where toField (SharedMsgId m) = toField m
instance ToField SharedMsgId where toField (SharedMsgId m) = toField $ DB.Binary m
instance StrEncoding SharedMsgId where
strEncode (SharedMsgId m) = strEncode m
@ -253,7 +260,7 @@ data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknow
deriving (Eq, Show)
data ReportReason = RRSpam | RRContent | RRCommunity | RRProfile | RROther | RRUnknown Text
deriving (Eq, Show)
deriving (Eq, Show)
$(pure [])
@ -515,7 +522,7 @@ instance ToJSON MsgContentTag where
toJSON = strToJSON
toEncoding = strToJEncoding
instance FromField MsgContentTag where fromField = fromBlobField_ strDecode
instance FromField MsgContentTag where fromField = blobFieldDecoder strDecode
instance ToField MsgContentTag where toField = toField . strEncode
@ -570,9 +577,10 @@ durationText duration =
| otherwise = show n
msgContentHasText :: MsgContent -> Bool
msgContentHasText = not . T.null . \case
MCVoice {text} -> text
mc -> msgContentText mc
msgContentHasText =
not . T.null . \case
MCVoice {text} -> text
mc -> msgContentText mc
isVoice :: MsgContent -> Bool
isVoice = \case

8
src/Simplex/Chat/Remote.hs
View file

@ -37,7 +37,6 @@ import Data.Word (Word16, Word32)
import qualified Network.HTTP.Types as N
import Network.HTTP2.Server (responseStreaming)
import qualified Paths_simplex_chat as SC
import Simplex.Chat.Archive (archiveFilesFolder)
import Simplex.Chat.Controller
import Simplex.Chat.Files
import Simplex.Chat.Messages (chatNameStr)
@ -71,6 +70,9 @@ import UnliftIO
import UnliftIO.Concurrent (forkIO)
import UnliftIO.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, removeDirectoryRecursive, renameFile)
remoteFilesFolder :: String
remoteFilesFolder = "simplex_v1_files"
-- when acting as host
minRemoteCtrlVersion :: AppVersion
minRemoteCtrlVersion = AppVersion [6, 3, 0, 0]
@ -342,7 +344,7 @@ storeRemoteFile rhId encrypted_ localPath = do
filePath' <- liftRH rhId $ remoteStoreFile c filePath (takeFileName localPath)
hf_ <- chatReadVar remoteHostsFolder
forM_ hf_ $ \hf -> do
let rhf = hf </> storePath </> archiveFilesFolder
let rhf = hf </> storePath </> remoteFilesFolder
hPath = rhf </> takeFileName filePath'
createDirectoryIfMissing True rhf
(if encrypt then renameFile else copyFile) filePath hPath
@ -360,7 +362,7 @@ storeRemoteFile rhId encrypted_ localPath = do
getRemoteFile :: RemoteHostId -> RemoteFile -> CM ()
getRemoteFile rhId rf = do
c@RemoteHostClient {storePath} <- getRemoteHostClient rhId
dir <- lift $ (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar' remoteHostsFolder)
dir <- lift $ (</> storePath </> remoteFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar' remoteHostsFolder)
createDirectoryIfMissing True dir
liftRH rhId $ remoteGetFile c dir rf

34
src/Simplex/Chat/Store.hs
View file

@ -1,3 +1,5 @@
{-# LANGUAGE CPP #-}
module Simplex.Chat.Store
( DBStore,
StoreError (..),
@ -7,20 +9,43 @@ module Simplex.Chat.Store
AutoAccept (..),
createChatStore,
migrations, -- used in tests
#if defined(dbPostgres)
chatSchema,
agentSchema,
#else
chatStoreFile,
agentStoreFile,
#endif
withTransaction,
)
where
import Data.ByteArray (ScrubbedBytes)
import Simplex.Chat.Store.Migrations
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Messaging.Agent.Store.SQLite (createDBStore)
import Simplex.Messaging.Agent.Store.SQLite.Common (DBStore (..), withTransaction)
import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
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
@ -29,3 +54,4 @@ chatStoreFile = (<> "_chat.db")
agentStoreFile :: FilePath -> FilePath
agentStoreFile = (<> "_agent.db")
#endif

9
src/Simplex/Chat/Store/AppSettings.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Store.AppSettings where
@ -6,10 +7,14 @@ 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.AgentStore (maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Agent.Store.DB as DB
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..))
#else
import Database.SQLite.Simple (Only (..))
#endif
saveAppSettings :: DB.Connection -> AppSettings -> IO ()
saveAppSettings db appSettings = do

73
src/Simplex/Chat/Store/Connections.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@ -25,8 +26,6 @@ import Control.Monad.IO.Class
import Data.Bitraversable (bitraverse)
import Data.Int (Int64)
import Data.Maybe (catMaybes, fromMaybe)
import Database.SQLite.Simple (Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Files
@ -36,8 +35,16 @@ import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (ConnId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, firstRow', maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Util (eitherToMaybe)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
getChatLockEntity :: DB.Connection -> AgentConnId -> ExceptT StoreError IO ChatLockEntity
getChatLockEntity db agentConnId = do
@ -110,40 +117,42 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)) =
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData)) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
activeConn = Just conn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, chatTags, uiThemes, chatDeleted, customData}
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = do
gm <- ExceptT $ firstRow (toGroupAndMember c) (SEInternalError "referenced group member not found") $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|]
(groupMemberId, userId, userContactId)
gm <-
ExceptT $
firstRow (toGroupAndMember c) (SEInternalError "referenced group member not found") $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|]
(groupMemberId, userId, userContactId)
liftIO $ bitraverse (addGroupChatTags db) pure gm
toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember)
toGroupAndMember c (groupInfoRow :. memberRow) =
@ -212,7 +221,7 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2
WHERE user_id = ? AND via_contact_uri_hash IN (?,?) AND conn_status != ?
ORDER BY conn_ord DESC, created_at DESC
LIMIT 1
)
) c
|]
(userId, cReqHash1, cReqHash2, ConnDeleted)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_

184
src/Simplex/Chat/Store/Direct.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
@ -93,8 +94,6 @@ import Data.Int (Int64)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Database.SQLite.Simple (NamedParam (..), Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Messages
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
@ -102,11 +101,19 @@ import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util ((<$$>))
import Simplex.Messaging.Version
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
getPendingContactConnection :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO PendingContactConnection
getPendingContactConnection db userId connId = do
@ -160,9 +167,9 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, pccConnStatus, ConnContact, True, cReqHash, xContactId)
:. (customUserProfileId, isJust groupLinkId, groupLinkId)
:. (createdAt, createdAt, subMode == SMOnlyCreate, chatV, pqSup, pqSup)
( (userId, acId, pccConnStatus, ConnContact, BI True, cReqHash, xContactId)
:. (customUserProfileId, BI (isJust groupLinkId), groupLinkId)
:. (createdAt, createdAt, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
)
pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
@ -183,26 +190,27 @@ getConnReqContactXContactId db vr user@User {userId} cReqHash = do
getContactByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> IO (Maybe Contact)
getContactByConnReqHash db vr user@User {userId} cReqHash = do
ct_ <- maybeFirstRow (toContact vr user []) $
DB.query
db
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
JOIN connections c ON c.contact_id = ct.contact_id
WHERE c.user_id = ? AND c.via_contact_uri_hash = ? AND ct.contact_status = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
|]
(userId, cReqHash, CSActive)
ct_ <-
maybeFirstRow (toContact vr user []) $
DB.query
db
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
JOIN connections c ON c.contact_id = ct.contact_id
WHERE c.user_id = ? AND c.via_contact_uri_hash = ? AND ct.contact_status = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
|]
(userId, cReqHash, CSActive)
mapM (addDirectChatTags db) ct_
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
@ -218,8 +226,8 @@ createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, cReq, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId)
:. (createdAt, createdAt, subMode == SMOnlyCreate, chatV, pqSup, pqSup)
( (userId, acId, cReq, pccConnStatus, ConnContact, BI contactConnInitiated, customUserProfileId)
:. (createdAt, createdAt, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
)
pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt}
@ -342,31 +350,33 @@ deleteContactProfile_ db userId contactId =
deleteUnusedProfile_ :: DB.Connection -> UserId -> ProfileId -> IO ()
deleteUnusedProfile_ db userId profileId =
DB.executeNamed
DB.execute
db
[sql|
DELETE FROM contact_profiles
WHERE user_id = :user_id AND contact_profile_id = :profile_id
WHERE user_id = ? AND contact_profile_id = ?
AND 1 NOT IN (
SELECT 1 FROM connections
WHERE user_id = :user_id AND custom_user_profile_id = :profile_id LIMIT 1
WHERE user_id = ? AND custom_user_profile_id = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM contacts
WHERE user_id = :user_id AND contact_profile_id = :profile_id LIMIT 1
WHERE user_id = ? AND contact_profile_id = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM contact_requests
WHERE user_id = :user_id AND contact_profile_id = :profile_id LIMIT 1
WHERE user_id = ? AND contact_profile_id = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM group_members
WHERE user_id = :user_id
AND (member_profile_id = :profile_id OR contact_profile_id = :profile_id)
WHERE user_id = ?
AND (member_profile_id = ? OR contact_profile_id = ?)
LIMIT 1
)
|]
[":user_id" := userId, ":profile_id" := profileId]
( (userId, profileId, userId, profileId, userId, profileId)
:. (userId, profileId, userId, profileId, profileId)
)
updateContactProfile :: DB.Connection -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile db user@User {userId} c p'
@ -465,14 +475,14 @@ updateContactUsed db User {userId} Contact {contactId} = do
updateContactUnreadChat :: DB.Connection -> User -> Contact -> Bool -> IO ()
updateContactUnreadChat db User {userId} Contact {contactId} unreadChat = do
updatedAt <- getCurrentTime
DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (unreadChat, updatedAt, userId, contactId)
DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (BI unreadChat, updatedAt, userId, contactId)
setUserChatsRead :: DB.Connection -> User -> IO ()
setUserChatsRead db User {userId} = do
updatedAt <- getCurrentTime
DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True)
DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True)
DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True)
DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (BI False, updatedAt, userId, BI True)
DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (BI False, updatedAt, userId, BI True)
DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (BI False, updatedAt, userId, BI True)
DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND item_status = ?" (CISRcvRead, updatedAt, userId, CISRcvNew)
updateContactStatus :: DB.Connection -> User -> Contact -> ContactStatus -> IO Contact
@ -491,7 +501,7 @@ updateContactStatus db User {userId} ct@Contact {contactId} contactStatus = do
updateGroupUnreadChat :: DB.Connection -> User -> GroupInfo -> Bool -> IO ()
updateGroupUnreadChat db User {userId} GroupInfo {groupId} unreadChat = do
updatedAt <- getCurrentTime
DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (unreadChat, updatedAt, userId, groupId)
DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (BI unreadChat, updatedAt, userId, groupId)
setConnectionVerified :: DB.Connection -> User -> Int64 -> Maybe Text -> IO ()
setConnectionVerified db User {userId} connId code = do
@ -635,40 +645,42 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact
created_at, updated_at, xcontact_id, pq_support)
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|]
( (userContactLinkId, invId, minV, maxV, profileId, ldn, userId)
( (userContactLinkId, Binary invId, minV, maxV, profileId, ldn, userId)
:. (currentTs, currentTs, xContactId_, pqSup)
)
insertedRowId db
getContact' :: XContactId -> IO (Maybe Contact)
getContact' xContactId = do
ct_ <- maybeFirstRow (toContact vr user []) $
DB.query
db
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
|]
(userId, xContactId)
ct_ <-
maybeFirstRow (toContact vr user []) $
DB.query
db
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
|]
(userId, xContactId)
mapM (addDirectChatTags db) ct_
getGroupInfo' :: XContactId -> IO (Maybe GroupInfo)
getGroupInfo' xContactId = do
g_ <- maybeFirstRow (toGroupInfo vr userContactId []) $
DB.query
db
(groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
(xContactId, userId, userContactId)
g_ <-
maybeFirstRow (toGroupInfo vr userContactId []) $
DB.query
db
(groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
(xContactId, userId, userContactId)
mapM (addGroupChatTags db) g_
getContactRequestByXContactId :: XContactId -> IO (Maybe UserContactRequest)
getContactRequestByXContactId xContactId =
@ -702,7 +714,7 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact
SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ?
WHERE user_id = ? AND contact_request_id = ?
|]
(invId, pqSup, minV, maxV, currentTs, userId, cReqId)
(Binary invId, pqSup, minV, maxV, currentTs, userId, cReqId)
else withLocalDisplayName db userId displayName $ \ldn ->
Right <$> do
DB.execute
@ -712,7 +724,7 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact
SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ?
WHERE user_id = ? AND contact_request_id = ?
|]
(invId, pqSup, minV, maxV, ldn, currentTs, userId, cReqId)
(Binary invId, pqSup, minV, maxV, ldn, currentTs, userId, cReqId)
safeDeleteLDN db user oldLdn
where
updateProfile currentTs =
@ -803,7 +815,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
DB.execute
db
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)"
(userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId, contactUsed)
(userId, localDisplayName, profileId, BI True, userPreferences, createdAt, createdAt, createdAt, xContactId, BI contactUsed)
contactId <- insertedRowId db
DB.execute db "UPDATE contact_requests SET contact_id = ? WHERE user_id = ? AND local_display_name = ?" (contactId, userId, localDisplayName)
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId ConnNew connChatVersion cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode pqSup
@ -841,7 +853,7 @@ updateContactAccepted db User {userId} Contact {contactId} contactUsed =
DB.execute
db
"UPDATE contacts SET contact_used = ? WHERE user_id = ? AND contact_id = ?"
(contactUsed, userId, contactId)
(BI contactUsed, userId, contactId)
getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
getContactIdByName db User {userId} cName =
@ -882,12 +894,12 @@ getContact_ db vr user@User {userId} contactId deleted = do
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
LIMIT 1
)
) cc
)
OR c.connection_id IS NULL
)
|]
(userId, contactId, deleted, ConnReady, ConnSndReady)
(userId, contactId, BI deleted, ConnReady, ConnSndReady)
getUserByContactRequestId :: DB.Connection -> Int64 -> ExceptT StoreError IO User
getUserByContactRequestId db contactRequestId =
@ -897,16 +909,16 @@ getUserByContactRequestId db contactRequestId =
getPendingContactConnections :: DB.Connection -> User -> IO [PendingContactConnection]
getPendingContactConnections db User {userId} = do
map toPendingContactConnection
<$> DB.queryNamed
<$> DB.query
db
[sql|
SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id, custom_user_profile_id, conn_req_inv, local_alias, created_at, updated_at
FROM connections
WHERE user_id = :user_id
AND conn_type = :conn_type
WHERE user_id = ?
AND conn_type = ?
AND contact_id IS NULL
|]
[":user_id" := userId, ":conn_type" := ConnContact]
(userId, ConnContact)
getContactConnections :: DB.Connection -> VersionRangeChat -> UserId -> Contact -> IO [Connection]
getContactConnections db vr userId Contact {contactId} =
@ -945,9 +957,13 @@ getConnectionById db vr User {userId} connId = ExceptT $ do
getConnectionsContacts :: DB.Connection -> [ConnId] -> IO [ContactRef]
getConnectionsContacts db agentConnIds = do
DB.execute_ db "DROP TABLE IF EXISTS temp.conn_ids"
DB.execute_ db "CREATE TABLE temp.conn_ids (conn_id BLOB)"
DB.executeMany db "INSERT INTO temp.conn_ids (conn_id) VALUES (?)" $ map Only agentConnIds
DB.execute_ db "DROP TABLE IF EXISTS temp_conn_ids"
#if defined(dbPostgres)
DB.execute_ db "CREATE TABLE temp_conn_ids (conn_id BYTEA)"
#else
DB.execute_ db "CREATE TABLE temp_conn_ids (conn_id BLOB)"
#endif
DB.executeMany db "INSERT INTO temp_conn_ids (conn_id) VALUES (?)" $ map Only agentConnIds
conns <-
map toContactRef
<$> DB.query
@ -956,12 +972,12 @@ getConnectionsContacts db agentConnIds = do
SELECT ct.contact_id, c.connection_id, c.agent_conn_id, ct.local_display_name
FROM contacts ct
JOIN connections c ON c.contact_id = ct.contact_id
WHERE c.agent_conn_id IN (SELECT conn_id FROM temp.conn_ids)
WHERE c.agent_conn_id IN (SELECT conn_id FROM temp_conn_ids)
AND c.conn_type = ?
AND ct.deleted = 0
|]
(Only ConnContact)
DB.execute_ db "DROP TABLE temp.conn_ids"
DB.execute_ db "DROP TABLE temp_conn_ids"
pure conns
where
toContactRef :: (ContactId, Int64, ConnId, ContactName) -> ContactRef
@ -986,7 +1002,7 @@ updateConnectionStatus_ db connId connStatus = do
updateContactSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateContactSettings db User {userId} contactId ChatSettings {enableNtfs, sendRcpts, favorite} =
DB.execute db "UPDATE contacts SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND contact_id = ?" (enableNtfs, sendRcpts, favorite, userId, contactId)
DB.execute db "UPDATE contacts SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND contact_id = ?" (enableNtfs, BI <$> sendRcpts, BI favorite, userId, contactId)
setConnConnReqInv :: DB.Connection -> User -> Int64 -> ConnReqInvitation -> IO ()
setConnConnReqInv db User {userId} connId connReq = do
@ -1025,7 +1041,7 @@ setContactUIThemes db User {userId} Contact {contactId} uiThemes = do
setContactChatDeleted :: DB.Connection -> User -> Contact -> Bool -> IO ()
setContactChatDeleted db User {userId} Contact {contactId} chatDeleted = do
updatedAt <- getCurrentTime
DB.execute db "UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (chatDeleted, updatedAt, userId, contactId)
DB.execute db "UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (BI chatDeleted, updatedAt, userId, contactId)
updateDirectChatTags :: DB.Connection -> ContactId -> [ChatTagId] -> IO ()
updateDirectChatTags db contactId tIds = do

54
src/Simplex/Chat/Store/Files.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
@ -96,9 +97,6 @@ import Data.Time (addUTCTime)
import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
import Data.Type.Equality
import Data.Word (Word32)
import Database.SQLite.Simple (Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Database.SQLite.Simple.ToField (ToField)
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol
@ -110,7 +108,8 @@ import Simplex.Chat.Types
import Simplex.Chat.Util (week)
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, firstRow', maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
@ -118,6 +117,15 @@ import Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Version
import System.FilePath (takeFileName)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.ToField (ToField)
#else
import Database.SQLite.Simple (Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Database.SQLite.Simple.ToField (ToField)
#endif
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
getLiveSndFileTransfers db User {userId} = do
@ -283,7 +291,7 @@ createSndFTDescrXFTP db User {userId} m Connection {connId} FileTransferMeta {fi
DB.execute
db
"INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(userId, fileDescrText, fileDescrPartNo, fileDescrComplete, currentTs, currentTs)
(userId, fileDescrText, fileDescrPartNo, BI fileDescrComplete, currentTs, currentTs)
fileDescrId <- insertedRowId db
DB.execute
db
@ -308,7 +316,7 @@ updateSndFTDescrXFTP db user@User {userId} sft@SndFileTransfer {fileId, fileDesc
SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?, updated_at = ?
WHERE user_id = ? AND file_descr_id = ?
|]
(rfdText, 1 :: Int, True, currentTs, userId, fileDescrId)
(rfdText, 1 :: Int, BI True, currentTs, userId, fileDescrId)
updateCIFileStatus db user fileId $ CIFSSndTransfer 1 1
updateSndFileStatus db sft FSConnected
@ -574,7 +582,7 @@ createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, file
DB.execute
db
"INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(userId, fileDescrText, fileDescrPartNo, fileDescrComplete, currentTs, currentTs)
(userId, fileDescrText, fileDescrPartNo, BI fileDescrComplete, currentTs, currentTs)
insertedRowId db
pure RcvFileDescr {fileDescrId, fileDescrPartNo, fileDescrText, fileDescrComplete}
@ -607,7 +615,7 @@ appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileD
SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?
WHERE file_descr_id = ?
|]
(fileDescrText', fileDescrPartNo, fileDescrComplete, fileDescrId)
(fileDescrText', fileDescrPartNo, BI fileDescrComplete, fileDescrId)
pure RcvFileDescr {fileDescrId, fileDescrText = fileDescrText', fileDescrPartNo, fileDescrComplete}
getRcvFileDescrByRcvFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
@ -650,8 +658,8 @@ getRcvFileDescrBySndFileId_ db fileId =
|]
(Only fileId)
toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
toRcvFileDescr :: (Int64, Text, Int, BoolInt) -> RcvFileDescr
toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, BI fileDescrComplete) =
RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
updateRcvFileAgentId :: DB.Connection -> FileTransferId -> Maybe AgentRcvFileId -> IO ()
@ -682,8 +690,8 @@ getRcvFileTransfer_ db userId fileId = do
FROM rcv_files r
JOIN files f USING (file_id)
LEFT JOIN connections c ON r.file_id = c.rcv_file_id
LEFT JOIN contacts cs USING (contact_id)
LEFT JOIN group_members m USING (group_member_id)
LEFT JOIN contacts cs ON cs.contact_id = f.contact_id
LEFT JOIN group_members m ON m.group_member_id = r.group_member_id
WHERE f.user_id = ? AND f.file_id = ?
|]
(userId, fileId)
@ -692,9 +700,9 @@ getRcvFileTransfer_ db userId fileId = do
where
rcvFileTransfer ::
Maybe RcvFileDescr ->
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, Bool, Bool) :. (Maybe Int64, Maybe AgentConnId) ->
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe BoolInt) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, BoolInt, BoolInt) :. (Maybe Int64, Maybe AgentConnId) ->
ExceptT StoreError IO RcvFileTransfer
rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, agentRcvFileDeleted, userApprovedRelays) :. (connId_, agentConnId_)) =
rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, BI agentRcvFileDeleted, BI userApprovedRelays) :. (connId_, agentConnId_)) =
case contactName_ <|> memberName_ <|> standaloneName_ of
Nothing -> throwError $ SERcvFileInvalid fileId
Just name ->
@ -717,7 +725,7 @@ getRcvFileTransfer_ db userId fileId = do
rfi_ = case (filePath_, connId_, agentConnId_) of
(Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
_ -> pure Nothing
cancelled = fromMaybe False cancelled_
cancelled = maybe False unBI cancelled_
acceptRcvFileTransfer :: DB.Connection -> VersionRangeChat -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do
@ -726,7 +734,7 @@ acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus f
DB.execute
db
"INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?)"
(acId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs, subMode == SMOnlyCreate)
(acId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs, BI (subMode == SMOnlyCreate))
connId <- insertedRowId db
setCommandConnId db user cmdId connId
runExceptT $ getChatItemByFileId db vr user fileId
@ -763,7 +771,7 @@ acceptRcvFT_ db User {userId} fileId filePath userApprovedRelays rcvFileInline c
DB.execute
db
"UPDATE rcv_files SET user_approved_relays = ?, rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?"
(userApprovedRelays, rcvFileInline, FSAccepted, currentTs, fileId)
(BI userApprovedRelays, rcvFileInline, FSAccepted, currentTs, fileId)
setRcvFileToReceive :: DB.Connection -> FileTransferId -> Bool -> Maybe CryptoFileArgs -> IO ()
setRcvFileToReceive db fileId userApprovedRelays cfArgs_ = do
@ -775,7 +783,7 @@ setRcvFileToReceive db fileId userApprovedRelays cfArgs_ = do
SET to_receive = 1, user_approved_relays = ?, updated_at = ?
WHERE file_id = ?
|]
(userApprovedRelays, currentTs, fileId)
(BI userApprovedRelays, currentTs, fileId)
forM_ cfArgs_ $ \cfArgs -> setFileCryptoArgs_ db fileId cfArgs currentTs
setFileCryptoArgs :: DB.Connection -> FileTransferId -> CryptoFileArgs -> IO ()
@ -928,8 +936,8 @@ getSndFileTransfers_ db userId fileId =
FROM snd_files s
JOIN files f USING (file_id)
JOIN connections c USING (connection_id)
LEFT JOIN contacts cs USING (contact_id)
LEFT JOIN group_members m USING (group_member_id)
LEFT JOIN contacts cs ON cs.contact_id = f.contact_id
LEFT JOIN group_members m ON m.group_member_id = s.group_member_id
WHERE f.user_id = ? AND f.file_id = ?
|]
(userId, fileId)
@ -955,11 +963,11 @@ getFileTransferMeta_ db userId fileId =
|]
(userId, fileId)
where
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe AgentSndFileId, Bool, Maybe Text, Maybe Bool, Maybe FileTransferId) -> FileTransferMeta
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileKey, fileNonce, fileInline, aSndFileId_, agentSndFileDeleted, privateSndFileDescr, cancelled_, xftpRedirectFor) =
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text, Maybe BoolInt, Maybe FileTransferId) -> FileTransferMeta
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileKey, fileNonce, fileInline, aSndFileId_, BI agentSndFileDeleted, privateSndFileDescr, cancelled_, xftpRedirectFor) =
let cryptoArgs = CFArgs <$> fileKey <*> fileNonce
xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted, cryptoArgs}) <$> aSndFileId_
in FileTransferMeta {fileId, xftpSndFile, xftpRedirectFor, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
in FileTransferMeta {fileId, xftpSndFile, xftpRedirectFor, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = maybe False unBI cancelled_}
lookupFileTransferRedirectMeta :: DB.Connection -> User -> Int64 -> IO [FileTransferMeta]
lookupFileTransferRedirectMeta db User {userId} fileId = do

342
src/Simplex/Chat/Store/Groups.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
@ -141,8 +142,6 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Ord (Down (..))
import Data.Text (Text)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Messages
import Simplex.Chat.Protocol (groupForwardVersion)
import Simplex.Chat.Store.Direct
@ -152,16 +151,24 @@ import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
import Simplex.Messaging.Version
import UnliftIO.STM
#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
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
@ -175,7 +182,7 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName}
DB.execute
db
"INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs)
(userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, BI True, currentTs, currentTs)
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff
@ -254,41 +261,42 @@ setGroupLinkMemberRole db User {userId} userContactLinkId memberRole =
getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRangeChat -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember db User {userId, userContactId} groupMemberId vr = do
gm <- ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|]
(userId, groupMemberId, userId, userContactId)
gm <-
ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|]
(userId, groupMemberId, userId, userContactId)
liftIO $ bitraverse (addGroupChatTags db) pure gm
where
toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember)
@ -319,7 +327,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
created_at, updated_at, chat_ts, user_member_profile_sent_at)
VALUES (?,?,?,?,?,?,?,?)
|]
(ldn, userId, profileId, True, currentTs, currentTs, currentTs, currentTs)
(ldn, userId, profileId, BI True, currentTs, currentTs, currentTs, currentTs)
insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs vr
@ -387,7 +395,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
((profileId, localDisplayName, connRequest, customUserProfileId, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
insertedRowId db
let hostVRange = adjustedMemberVRange vr peerChatVRange
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
@ -532,7 +540,7 @@ createGroupInvitedViaLink
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|]
((profileId, localDisplayName, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
((profileId, localDisplayName, customUserProfileId, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
insertedRowId db
insertHost_ currentTs groupId = do
let fromMemberProfile = profileFromName fromMemberName
@ -632,24 +640,28 @@ getUserGroups db vr user@User {userId} = do
getUserGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
g_ <- map (toGroupInfo vr userContactId [])
<$> DB.query
db
[sql|
SELECT
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id)
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
WHERE g.user_id = ? AND mu.contact_id = ?
AND (gp.display_name LIKE '%' || ? || '%' OR gp.full_name LIKE '%' || ? || '%' OR gp.description LIKE '%' || ? || '%')
|]
(userId, userContactId, search, search, search)
g_ <-
map (toGroupInfo vr userContactId [])
<$> DB.query
db
[sql|
SELECT
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id)
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
WHERE g.user_id = ? AND mu.contact_id = ?
AND (LOWER(gp.display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(gp.full_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(gp.description) LIKE '%' || LOWER(?) || '%'
)
|]
(userId, userContactId, search, search, search)
mapM (addGroupChatTags db) g_
where
search = fromMaybe "" search_
@ -958,7 +970,7 @@ createBusinessRequestGroup
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_xcontact_id)
VALUES (?,?,?,?,?,?,?,?,?,?)
|]
(profileId, localDisplayName, userId, True, currentTs, currentTs, currentTs, currentTs, BCCustomer, xContactId)
(profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs, BCCustomer, xContactId)
insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs vr
@ -1193,57 +1205,47 @@ createIntroductions db chatV members toMember = do
updateIntroStatus :: DB.Connection -> Int64 -> GroupMemberIntroStatus -> IO ()
updateIntroStatus db introId introStatus = do
currentTs <- getCurrentTime
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_member_intros
SET intro_status = :intro_status, updated_at = :updated_at
WHERE group_member_intro_id = :intro_id
SET intro_status = ?, updated_at = ?
WHERE group_member_intro_id = ?
|]
[":intro_status" := introStatus, ":updated_at" := currentTs, ":intro_id" := introId]
(introStatus, currentTs, introId)
saveIntroInvitation :: DB.Connection -> GroupMember -> GroupMember -> IntroInvitation -> ExceptT StoreError IO GroupMemberIntro
saveIntroInvitation db reMember toMember introInv@IntroInvitation {groupConnReq} = do
intro <- getIntroduction db reMember toMember
liftIO $ do
currentTs <- getCurrentTime
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_member_intros
SET intro_status = :intro_status,
group_queue_info = :group_queue_info,
direct_queue_info = :direct_queue_info,
updated_at = :updated_at
WHERE group_member_intro_id = :intro_id
SET intro_status = ?,
group_queue_info = ?,
direct_queue_info = ?,
updated_at = ?
WHERE group_member_intro_id = ?
|]
[ ":intro_status" := GMIntroInvReceived,
":group_queue_info" := groupConnReq,
":direct_queue_info" := directConnReq introInv,
":updated_at" := currentTs,
":intro_id" := introId intro
]
(GMIntroInvReceived, groupConnReq, directConnReq introInv, currentTs, introId intro)
pure intro {introInvitation = Just introInv, introStatus = GMIntroInvReceived}
saveMemberInvitation :: DB.Connection -> GroupMember -> IntroInvitation -> IO ()
saveMemberInvitation db GroupMember {groupMemberId} IntroInvitation {groupConnReq, directConnReq} = do
currentTs <- getCurrentTime
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_members
SET member_status = :member_status,
group_queue_info = :group_queue_info,
direct_queue_info = :direct_queue_info,
updated_at = :updated_at
WHERE group_member_id = :group_member_id
SET member_status = ?,
group_queue_info = ?,
direct_queue_info = ?,
updated_at = ?
WHERE group_member_id = ?
|]
[ ":member_status" := GSMemIntroInvited,
":group_queue_info" := groupConnReq,
":direct_queue_info" := directConnReq,
":updated_at" := currentTs,
":group_member_id" := groupMemberId
]
(GSMemIntroInvited, groupConnReq, directConnReq, currentTs, groupMemberId)
getIntroduction :: DB.Connection -> GroupMember -> GroupMember -> ExceptT StoreError IO GroupMemberIntro
getIntroduction db reMember toMember = ExceptT $ do
@ -1364,14 +1366,14 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
pure contactId
updateMember_ :: Int64 -> UTCTime -> IO ()
updateMember_ contactId ts =
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_members
SET contact_id = :contact_id, updated_at = :updated_at
WHERE group_member_id = :group_member_id
SET contact_id = ?, updated_at = ?
WHERE group_member_id = ?
|]
[":contact_id" := contactId, ":updated_at" := ts, ":group_member_id" := groupMemberId]
(contactId, ts, groupMemberId)
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange viaContact connLevel currentTs subMode =
@ -1379,42 +1381,43 @@ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange
getViaGroupMember :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
gm_ <- maybeFirstRow toGroupAndMember $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contacts ct ON ct.contact_id = m.contact_id
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id AND g.group_id = ct.via_group
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
WHERE ct.user_id = ? AND ct.contact_id = ? AND mu.contact_id = ? AND ct.deleted = 0
|]
(userId, userId, contactId, userContactId)
gm_ <-
maybeFirstRow toGroupAndMember $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contacts ct ON ct.contact_id = m.contact_id
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id AND g.group_id = ct.via_group
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
WHERE ct.user_id = ? AND ct.contact_id = ? AND mu.contact_id = ? AND ct.deleted = 0
|]
(userId, userId, contactId, userContactId)
mapM (bitraverse (addGroupChatTags db) pure) gm_
where
toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember)
@ -1650,7 +1653,7 @@ createSentProbe db gVar userId to =
DB.execute
db
"INSERT INTO sent_probes (contact_id, group_member_id, probe, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(ctId, gmId, probe, userId, currentTs, currentTs)
(ctId, gmId, Binary probe, userId, currentTs, currentTs)
(Probe probe,) <$> insertedRowId db
createSentProbeHash :: DB.Connection -> UserId -> Int64 -> ContactOrMember -> IO ()
@ -1676,13 +1679,13 @@ matchReceivedProbe db vr user@User {userId} from (Probe probe) = do
LEFT JOIN groups g ON g.group_id = m.group_id
WHERE r.user_id = ? AND r.probe_hash = ? AND r.probe IS NULL
|]
(userId, probeHash)
(userId, Binary probeHash)
currentTs <- getCurrentTime
let (ctId, gmId) = contactOrMemberIds from
DB.execute
db
"INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(ctId, gmId, probe, probeHash, userId, currentTs, currentTs)
(ctId, gmId, Binary probe, Binary probeHash, userId, currentTs, currentTs)
let cgmIds' = filterFirstContactId cgmIds
catMaybes <$> mapM (getContactOrMember_ db vr user) cgmIds'
where
@ -1708,13 +1711,13 @@ matchReceivedProbeHash db vr user@User {userId} from (ProbeHash probeHash) = do
LEFT JOIN groups g ON g.group_id = m.group_id
WHERE r.user_id = ? AND r.probe_hash = ? AND r.probe IS NOT NULL
|]
(userId, probeHash)
(userId, Binary probeHash)
currentTs <- getCurrentTime
let (ctId, gmId) = contactOrMemberIds from
DB.execute
db
"INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(ctId, gmId, probeHash, userId, currentTs, currentTs)
(ctId, gmId, Binary probeHash, userId, currentTs, currentTs)
pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db vr user cgmIds
matchSentProbe :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
@ -1736,7 +1739,7 @@ matchSentProbe db vr user@User {userId} _from (Probe probe) = do
WHERE s.user_id = ? AND s.probe = ?
AND (h.contact_id = ? OR h.group_member_id = ?)
|]
(userId, probe, ctId, gmId)
(userId, Binary probe, ctId, gmId)
getContactOrMember_ :: DB.Connection -> VersionRangeChat -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
getContactOrMember_ db vr user ids =
@ -1777,22 +1780,18 @@ mergeContactRecords db vr user@User {userId} to@Contact {localDisplayName = keep
db
"UPDATE chat_items SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
(toContactId, currentTs, fromContactId, userId)
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_members
SET contact_id = :to_contact_id,
local_display_name = (SELECT local_display_name FROM contacts WHERE contact_id = :to_contact_id),
contact_profile_id = (SELECT contact_profile_id FROM contacts WHERE contact_id = :to_contact_id),
updated_at = :updated_at
WHERE contact_id = :from_contact_id
AND user_id = :user_id
SET contact_id = ?,
local_display_name = (SELECT local_display_name FROM contacts WHERE contact_id = ?),
contact_profile_id = (SELECT contact_profile_id FROM contacts WHERE contact_id = ?),
updated_at = ?
WHERE contact_id = ?
AND user_id = ?
|]
[ ":to_contact_id" := toContactId,
":from_contact_id" := fromContactId,
":user_id" := userId,
":updated_at" := currentTs
]
(toContactId, toContactId, toContactId, currentTs, fromContactId, userId)
deleteContactProfile_ db userId fromContactId
DB.execute db "DELETE FROM contacts WHERE contact_id = ? AND user_id = ?" (fromContactId, userId)
deleteUnusedDisplayName_ db userId fromLDN
@ -1867,41 +1866,44 @@ associateContactWithMemberRecord
deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO ()
deleteUnusedDisplayName_ db userId localDisplayName =
DB.executeNamed
DB.execute
db
[sql|
DELETE FROM display_names
WHERE user_id = :user_id AND local_display_name = :local_display_name
WHERE user_id = ? AND local_display_name = ?
AND 1 NOT IN (
SELECT 1 FROM users
WHERE local_display_name = :local_display_name LIMIT 1
WHERE local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM contacts
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM groups
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM group_members
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM user_contact_links
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM contact_requests
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM contact_requests
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
|]
[":user_id" := userId, ":local_display_name" := localDisplayName]
( (userId, localDisplayName, localDisplayName, userId, localDisplayName, userId, localDisplayName)
:. (userId, localDisplayName, userId, localDisplayName, userId, localDisplayName)
:. (userId, localDisplayName)
)
deleteOldProbes :: DB.Connection -> UTCTime -> IO ()
deleteOldProbes db createdAtCutoff = do
@ -1911,7 +1913,7 @@ deleteOldProbes db createdAtCutoff = do
updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} =
DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, sendRcpts, favorite, userId, groupId)
DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, BI <$> sendRcpts, BI favorite, userId, groupId)
updateGroupMemberSettings :: DB.Connection -> User -> GroupId -> GroupMemberId -> GroupMemberSettings -> IO ()
updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {showMessages} = do
@ -1923,7 +1925,7 @@ updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {sh
SET show_messages = ?, updated_at = ?
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|]
(showMessages, currentTs, userId, gId, gMemberId)
(BI showMessages, currentTs, userId, gId, gMemberId)
updateGroupMemberBlocked :: DB.Connection -> User -> GroupId -> GroupMemberId -> MemberRestrictionStatus -> IO ()
updateGroupMemberBlocked db User {userId} gId gMemberId memberBlocked = do
@ -2025,8 +2027,8 @@ createMemberContact
contact_group_member_id, contact_grp_inv_sent, created_at, updated_at, chat_ts
) VALUES (?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, localDisplayName, memberContactProfileId, True, userPreferences, True)
:. (groupMemberId, False, currentTs, currentTs, currentTs)
( (userId, localDisplayName, memberContactProfileId, BI True, userPreferences, BI True)
:. (groupMemberId, BI False, currentTs, currentTs, currentTs)
)
contactId <- insertedRowId db
DB.execute
@ -2041,8 +2043,8 @@ createMemberContact
conn_chat_version, peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, True, contactId, customUserProfileId)
:. (connChatVersion, minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, BI True, contactId, customUserProfileId)
:. (connChatVersion, minV, maxV, currentTs, currentTs, BI (subMode == SMOnlyCreate))
)
connId <- insertedRowId db
let ctConn =
@ -2093,7 +2095,7 @@ setContactGrpInvSent db Contact {contactId} xGrpDirectInvSent = do
DB.execute
db
"UPDATE contacts SET contact_grp_inv_sent = ?, updated_at = ? WHERE contact_id = ?"
(xGrpDirectInvSent, currentTs, contactId)
(BI xGrpDirectInvSent, currentTs, contactId)
createMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> GroupMember -> Connection -> SubscriptionMode -> IO (Contact, GroupMember)
createMemberContactInvited
@ -2123,7 +2125,7 @@ createMemberContactInvited
created_at, updated_at, chat_ts
) VALUES (?,?,?,?,?,?,?,?,?)
|]
( (userId, memberLDN, memberContactProfileId, True, userPreferences, True)
( (userId, memberLDN, memberContactProfileId, BI True, userPreferences, BI True)
:. (currentTs, currentTs, currentTs)
)
contactId <- insertedRowId db
@ -2175,7 +2177,7 @@ createMemberContactConn_
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, connLevel, ConnJoined, ConnContact, contactId, customUserProfileId)
:. (connChatVersion, minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
:. (connChatVersion, minV, maxV, currentTs, currentTs, BI (subMode == SMOnlyCreate))
)
connId <- insertedRowId db
setCommandConnId db user cmdId connId
@ -2244,7 +2246,7 @@ updateContactMemberProfile db user@User {userId} m ct@Contact {contactId} p'
getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
getXGrpLinkMemReceived db mId =
ExceptT . firstRow fromOnly (SEGroupMemberNotFound mId) $
ExceptT . firstRow fromOnlyBI (SEGroupMemberNotFound mId) $
DB.query db "SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ?" (Only mId)
setXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> Bool -> IO ()
@ -2253,7 +2255,7 @@ setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do
DB.execute
db
"UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
(xGrpLinkMemReceived, currentTs, mId)
(BI xGrpLinkMemReceived, currentTs, mId)
createNewUnknownGroupMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember
createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {groupId} memberId memberName = do

328
src/Simplex/Chat/Store/Messages.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
@ -140,8 +141,6 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (addUTCTime)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), Query, ToRow, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Controller (ChatListQuery (..), ChatPagination (..), ContentFilter (..), PaginationByTime (..))
import Simplex.Chat.Markdown
import Simplex.Chat.Messages
@ -160,6 +159,13 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import Simplex.Messaging.Util (eitherToMaybe)
import UnliftIO.STM
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (FromRow, Only (..), Query, ToRow, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (FromRow, Only (..), Query, ToRow, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
deleteContactCIs :: DB.Connection -> User -> Contact -> IO ()
deleteContactCIs db user@User {userId} ct@Contact {contactId} = do
@ -200,7 +206,7 @@ createNewSndMessage db gVar connOrGroupId chatMsgEvent encodeMessage =
shared_msg_id, shared_msg_id_user, created_at, updated_at
) VALUES (?,?,?,?,?,?,?,?,?)
|]
(MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, sharedMsgId, Just True, createdAt, createdAt)
(MDSnd, toCMEventTag chatMsgEvent, DB.Binary msgBody, connId_, groupId_, DB.Binary sharedMsgId, Just (BI True), createdAt, createdAt)
msgId <- insertedRowId db
pure $ Right SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody}
where
@ -285,7 +291,7 @@ createNewRcvMessage db connOrGroupId NewRcvMessage {chatMsgEvent, msgBody} share
(msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id, author_group_member_id, forwarded_by_group_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?)
|]
(MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_, authorMember, forwardedByMember)
(MDRcv, toCMEventTag chatMsgEvent, DB.Binary msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_, authorMember, forwardedByMember)
msgId <- insertedRowId db
pure RcvMessage {msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorMember, forwardedByMember}
@ -415,13 +421,14 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
fwd_from_tag, fwd_from_chat_name, fwd_from_msg_dir, fwd_from_contact_id, fwd_from_group_id, fwd_from_chat_item_id
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((userId, msgId_) :. idsRow :. itemRow :. quoteRow :. forwardedFromRow)
((userId, msgId_) :. idsRow :. itemRow :. quoteRow' :. forwardedFromRow)
ciId <- insertedRowId db
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt
pure ciId
where
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, msgContentTag <$> ciMsgContent ciContent, sharedMsgId, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe BoolInt) :. (Maybe Int, Maybe UTCTime)
itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, msgContentTag <$> ciMsgContent ciContent, sharedMsgId, forwardedByMember) :. (createdAt, createdAt, BI <$> (justTrue live)) :. ciTimedRow timed
quoteRow' = let (a, b, c, d, e) = quoteRow in (a, b, c, BI <$> d, e)
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
idsRow = case chatDirection of
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
@ -452,11 +459,11 @@ getChatItemQuote_ :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirectio
getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} =
case chatDirection of
CDDirectRcv Contact {contactId} -> getDirectChatItemQuote_ contactId (not sent)
CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {memberId = senderMemberId} ->
CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {groupMemberId = senderGMId, memberId = senderMemberId} ->
case memberId of
Just mId
| mId == userMemberId -> (`ciQuote` CIQGroupSnd) <$> getUserGroupChatItemId_ groupId
| mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender)) <$> getGroupChatItemId_ groupId mId
| mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender)) <$> getGroupChatItemId_ groupId senderGMId
| otherwise -> getGroupChatItemQuote_ groupId mId
_ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing
where
@ -468,7 +475,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
DB.query
db
"SELECT chat_item_id FROM chat_items WHERE user_id = ? AND contact_id = ? AND shared_msg_id = ? AND item_sent = ?"
(userId, contactId, msgId, userSent)
(userId, contactId, msgId, BI userSent)
where
ciQuoteDirect :: Maybe ChatItemId -> CIQuote 'CTDirect
ciQuoteDirect = (`ciQuote` if userSent then CIQDirectSnd else CIQDirectRcv)
@ -479,17 +486,17 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
db
"SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? AND item_sent = ? AND group_member_id IS NULL"
(userId, groupId, msgId, MDSnd)
getGroupChatItemId_ :: Int64 -> MemberId -> IO (Maybe ChatItemId)
getGroupChatItemId_ groupId mId =
getGroupChatItemId_ :: Int64 -> GroupMemberId -> IO (Maybe ChatItemId)
getGroupChatItemId_ groupId groupMemberId =
maybeFirstRow fromOnly $
DB.query
db
"SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? AND item_sent = ? AND group_member_id = ?"
(userId, groupId, msgId, MDRcv, mId)
(userId, groupId, msgId, MDRcv, groupMemberId)
getGroupChatItemQuote_ :: Int64 -> MemberId -> IO (CIQuote 'CTGroup)
getGroupChatItemQuote_ groupId mId = do
ciQuoteGroup
<$> DB.queryNamed
<$> DB.query
db
[sql|
SELECT i.chat_item_id,
@ -503,10 +510,10 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
LEFT JOIN chat_items i ON i.user_id = m.user_id
AND i.group_id = m.group_id
AND m.group_member_id = i.group_member_id
AND i.shared_msg_id = :msg_id
WHERE m.user_id = :user_id AND m.group_id = :group_id AND m.member_id = :member_id
AND i.shared_msg_id = ?
WHERE m.user_id = ? AND m.group_id = ? AND m.member_id = ?
|]
[":user_id" := userId, ":group_id" := groupId, ":member_id" := mId, ":msg_id" := msgId]
(msgId, userId, groupId, mId)
where
ciQuoteGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup
ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
@ -564,14 +571,21 @@ findDirectChatPreviews_ db User {userId} pagination clq =
ACPD SCTDirect $ DirectChatPD ts contactId lastItemId_ (toChatStats statsRow)
baseQuery =
[sql|
SELECT ct.contact_id, ct.chat_ts as ts, LastItems.chat_item_id, COALESCE(ChatStats.UnreadCount, 0), 0, COALESCE(ChatStats.MinUnread, 0), ct.unread_chat
SELECT
ct.contact_id,
ct.chat_ts,
(
SELECT chat_item_id
FROM chat_items ci
WHERE ci.user_id = ? AND ci.contact_id = ct.contact_id
ORDER BY ci.created_at DESC
LIMIT 1
) AS chat_item_id,
COALESCE(ChatStats.UnreadCount, 0),
0,
COALESCE(ChatStats.MinUnread, 0),
ct.unread_chat
FROM contacts ct
LEFT JOIN (
SELECT contact_id, chat_item_id, MAX(created_at)
FROM chat_items
WHERE user_id = ? AND contact_id IS NOT NULL
GROUP BY contact_id
) LastItems ON LastItems.contact_id = ct.contact_id
LEFT JOIN (
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
@ -582,58 +596,61 @@ findDirectChatPreviews_ db User {userId} pagination clq =
baseParams = (userId, userId, CISRcvNew)
getPreviews = case clq of
CLQFilters {favorite = False, unread = False} -> do
let q = baseQuery <> " WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used"
let q = baseQuery <> " WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1"
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = True, unread = False} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1
AND ct.favorite = 1
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = False, unread = True} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1
AND (ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = True, unread = True} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1
AND (ct.favorite = 1
OR ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQSearch {search} -> do
let q =
baseQuery
<> " "
<> [sql|
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1
AND (
ct.local_display_name LIKE '%' || ? || '%'
OR cp.display_name LIKE '%' || ? || '%'
OR cp.full_name LIKE '%' || ? || '%'
OR cp.local_alias LIKE '%' || ? || '%'
LOWER(ct.local_display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(cp.display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(cp.full_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(cp.local_alias) LIKE '%' || LOWER(?) || '%'
)
|]
|]
p = baseParams :. (userId, search, search, search, search)
queryWithPagination db q p pagination
queryWithPagination :: ToRow p => DB.Connection -> Query -> p -> PaginationByTime -> IO [(ContactId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination db query params = \case
PTLast count -> DB.query db (query <> " ORDER BY ts DESC LIMIT ?") (params :. Only count)
PTAfter ts count -> DB.query db (query <> " AND ts > ? ORDER BY ts ASC LIMIT ?") (params :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND ts < ? ORDER BY ts DESC LIMIT ?") (params :. (ts, count))
queryWithPagination q p
queryWithPagination :: ToRow p => Query -> p -> IO [(ContactId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination query params = case pagination of
PTLast count -> DB.query db (query <> " ORDER BY ct.chat_ts DESC LIMIT ?") (params :. Only count)
PTAfter ts count -> DB.query db (query <> " AND ct.chat_ts > ? ORDER BY ct.chat_ts ASC LIMIT ?") (params :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND ct.chat_ts < ? ORDER BY ct.chat_ts DESC LIMIT ?") (params :. (ts, count))
getDirectChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
getDirectChatPreview_ db vr user (DirectChatPD _ contactId lastItemId_ stats) = do
@ -652,14 +669,21 @@ findGroupChatPreviews_ db User {userId} pagination clq =
ACPD SCTGroup $ GroupChatPD ts groupId lastItemId_ (toChatStats statsRow)
baseQuery =
[sql|
SELECT g.group_id, g.chat_ts as ts, LastItems.chat_item_id, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ReportCount.Count, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat
SELECT
g.group_id,
g.chat_ts,
(
SELECT chat_item_id
FROM chat_items ci
WHERE ci.user_id = ? AND ci.group_id = g.group_id
ORDER BY ci.item_ts DESC
LIMIT 1
) AS chat_item_id,
COALESCE(ChatStats.UnreadCount, 0),
COALESCE(ReportCount.Count, 0),
COALESCE(ChatStats.MinUnread, 0),
g.unread_chat
FROM groups g
LEFT JOIN (
SELECT group_id, chat_item_id, MAX(item_ts)
FROM chat_items
WHERE user_id = ? AND group_id IS NOT NULL
GROUP BY group_id
) LastItems ON LastItems.group_id = g.group_id
LEFT JOIN (
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
@ -679,50 +703,59 @@ findGroupChatPreviews_ db User {userId} pagination clq =
CLQFilters {favorite = False, unread = False} -> do
let q = baseQuery <> " WHERE g.user_id = ?"
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = True, unread = False} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE g.user_id = ?
AND g.favorite = 1
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = False, unread = True} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE g.user_id = ?
AND (g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = True, unread = True} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE g.user_id = ?
AND (g.favorite = 1
OR g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQSearch {search} -> do
let q =
baseQuery
<> " "
<> [sql|
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
WHERE g.user_id = ?
AND (
g.local_display_name LIKE '%' || ? || '%'
OR gp.display_name LIKE '%' || ? || '%'
OR gp.full_name LIKE '%' || ? || '%'
OR gp.description LIKE '%' || ? || '%'
LOWER(g.local_display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(gp.display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(gp.full_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(gp.description) LIKE '%' || LOWER(?) || '%'
)
|]
|]
p = baseParams :. (userId, search, search, search, search)
queryWithPagination db q p pagination
queryWithPagination q p
queryWithPagination :: ToRow p => Query -> p -> IO [(GroupId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination query params = case pagination of
PTLast count -> DB.query db (query <> " ORDER BY g.chat_ts DESC LIMIT ?") (params :. Only count)
PTAfter ts count -> DB.query db (query <> " AND g.chat_ts > ? ORDER BY g.chat_ts ASC LIMIT ?") (params :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND g.chat_ts < ? ORDER BY g.chat_ts DESC LIMIT ?") (params :. (ts, count))
getGroupChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do
@ -741,14 +774,21 @@ findLocalChatPreviews_ db User {userId} pagination clq =
ACPD SCTLocal $ LocalChatPD ts noteFolderId lastItemId_ (toChatStats statsRow)
baseQuery =
[sql|
SELECT nf.note_folder_id, nf.chat_ts as ts, LastItems.chat_item_id, COALESCE(ChatStats.UnreadCount, 0), 0, COALESCE(ChatStats.MinUnread, 0), nf.unread_chat
SELECT
nf.note_folder_id,
nf.chat_ts,
(
SELECT chat_item_id
FROM chat_items ci
WHERE ci.user_id = ? AND ci.note_folder_id = nf.note_folder_id
ORDER BY ci.created_at DESC
LIMIT 1
) AS chat_item_id,
COALESCE(ChatStats.UnreadCount, 0),
0,
COALESCE(ChatStats.MinUnread, 0),
nf.unread_chat
FROM note_folders nf
LEFT JOIN (
SELECT note_folder_id, chat_item_id, MAX(created_at)
FROM chat_items
WHERE user_id = ? AND note_folder_id IS NOT NULL
GROUP BY note_folder_id
) LastItems ON LastItems.note_folder_id = nf.note_folder_id
LEFT JOIN (
SELECT note_folder_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
@ -761,36 +801,44 @@ findLocalChatPreviews_ db User {userId} pagination clq =
CLQFilters {favorite = False, unread = False} -> do
let q = baseQuery <> " WHERE nf.user_id = ?"
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = True, unread = False} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE nf.user_id = ?
AND nf.favorite = 1
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = False, unread = True} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE nf.user_id = ?
AND (nf.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQFilters {favorite = True, unread = True} -> do
let q =
baseQuery
<> " "
<> [sql|
WHERE nf.user_id = ?
AND (nf.favorite = 1
OR nf.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
|]
p = baseParams :. Only userId
queryWithPagination db q p pagination
queryWithPagination q p
CLQSearch {} -> pure []
queryWithPagination :: ToRow p => Query -> p -> IO [(NoteFolderId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination query params = case pagination of
PTLast count -> DB.query db (query <> " ORDER BY nf.chat_ts DESC LIMIT ?") (params :. Only count)
PTAfter ts count -> DB.query db (query <> " AND nf.chat_ts > ? ORDER BY nf.chat_ts ASC LIMIT ?") (params :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND nf.chat_ts < ? ORDER BY nf.chat_ts DESC LIMIT ?") (params :. (ts, count))
getLocalChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTLocal -> ExceptT StoreError IO AChat
getLocalChatPreview_ db user (LocalChatPD _ noteFolderId lastItemId_ stats) = do
@ -833,9 +881,9 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
let itemDeleted' = case itemDeleted of
DBCINotDeleted -> Nothing
_ -> Just (CIDeleted @'CTLocal deletedTs)
itemEdited' = fromMaybe False itemEdited
itemEdited' = maybe False unBI itemEdited
itemForwarded = toCIForwardedFrom forwardedFromRow
in mkCIMeta itemId content itemText status sentViaProxy sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) currentTs itemTs Nothing createdAt updatedAt
ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
@ -852,7 +900,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.contact_id, cr.user_contact_link_id,
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences,
cr.created_at, cr.updated_at as ts,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
FROM contact_requests cr
JOIN connections c ON c.user_contact_link_id = cr.user_contact_link_id
@ -863,16 +911,16 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
AND uc.local_display_name = ''
AND uc.group_id IS NULL
AND (
cr.local_display_name LIKE '%' || ? || '%'
OR p.display_name LIKE '%' || ? || '%'
OR p.full_name LIKE '%' || ? || '%'
LOWER(cr.local_display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(p.display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(p.full_name) LIKE '%' || LOWER(?) || '%'
)
|]
params search = (userId, userId, search, search, search)
getPreviews search = case pagination of
PTLast count -> DB.query db (query <> " ORDER BY ts DESC LIMIT ?") (params search :. Only count)
PTAfter ts count -> DB.query db (query <> " AND ts > ? ORDER BY ts ASC LIMIT ?") (params search :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND ts < ? ORDER BY ts DESC LIMIT ?") (params search :. (ts, count))
PTLast count -> DB.query db (query <> " ORDER BY cr.updated_at DESC LIMIT ?") (params search :. Only count)
PTAfter ts count -> DB.query db (query <> " AND cr.updated_at > ? ORDER BY cr.updated_at ASC LIMIT ?") (params search :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND cr.updated_at < ? ORDER BY cr.updated_at DESC LIMIT ?") (params search :. (ts, count))
toPreview :: ContactRequestRow -> AChatPreviewData
toPreview cReqRow =
let cReq@UserContactRequest {updatedAt} = toContactRequest cReqRow
@ -891,7 +939,7 @@ getContactConnectionChatPreviews_ db User {userId} pagination clq = case clq of
[sql|
SELECT
connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id,
custom_user_profile_id, conn_req_inv, local_alias, created_at, updated_at as ts
custom_user_profile_id, conn_req_inv, local_alias, created_at, updated_at
FROM connections
WHERE user_id = ?
AND conn_type = ?
@ -899,14 +947,14 @@ getContactConnectionChatPreviews_ db User {userId} pagination clq = case clq of
AND contact_id IS NULL
AND conn_level = 0
AND via_contact IS NULL
AND (via_group_link = 0 || (via_group_link = 1 AND group_link_id IS NOT NULL))
AND local_alias LIKE '%' || ? || '%'
AND (via_group_link = 0 OR (via_group_link = 1 AND group_link_id IS NOT NULL))
AND LOWER(local_alias) LIKE '%' || LOWER(?) || '%'
|]
params search = (userId, ConnContact, ConnPrepared, search)
getPreviews search = case pagination of
PTLast count -> DB.query db (query <> " ORDER BY ts DESC LIMIT ?") (params search :. Only count)
PTAfter ts count -> DB.query db (query <> " AND ts > ? ORDER BY ts ASC LIMIT ?") (params search :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND ts < ? ORDER BY ts DESC LIMIT ?") (params search :. (ts, count))
PTLast count -> DB.query db (query <> " ORDER BY updated_at DESC LIMIT ?") (params search :. Only count)
PTAfter ts count -> DB.query db (query <> " AND updated_at > ? ORDER BY updated_at ASC LIMIT ?") (params search :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND updated_at < ? ORDER BY updated_at DESC LIMIT ?") (params search :. (ts, count))
toPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation, LocalAlias, UTCTime, UTCTime) -> AChatPreviewData
toPreview connRow =
let conn@PendingContactConnection {updatedAt} = toPendingContactConnection connRow
@ -942,7 +990,7 @@ getDirectChatItemIdsLast_ db User {userId} Contact {contactId} count search =
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
@ -1006,7 +1054,7 @@ getDirectCIsAfter_ db User {userId} Contact {contactId} afterCI count search =
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
@ -1029,7 +1077,7 @@ getDirectCIsBefore_ db User {userId} Contact {contactId} beforeCI count search =
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
@ -1121,7 +1169,7 @@ getContactNavInfo_ db User {userId} Contact {contactId} afterCI = do
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_status = ?
AND created_at = ? AND chat_item_id > ?
)
) ci
|]
( (userId, contactId, CISRcvNew, ciCreatedAt afterCI)
:. (userId, contactId, CISRcvNew, ciCreatedAt afterCI, cChatItemId afterCI)
@ -1143,7 +1191,7 @@ getContactNavInfo_ db User {userId} Contact {contactId} afterCI = do
FROM chat_items
WHERE user_id = ? AND contact_id = ?
AND created_at = ? AND chat_item_id > ?
)
) ci
|]
( (userId, contactId, ciCreatedAt afterCI)
:. (userId, contactId, ciCreatedAt afterCI, cChatItemId afterCI)
@ -1199,7 +1247,7 @@ getGroupChatItemIDs db User {userId} GroupInfo {groupId} contentFilter range cou
rangeQuery :: ToRow p => Query -> p -> Query -> IO [ChatItemId]
rangeQuery c p ob
| null search = searchQuery "" ()
| otherwise = searchQuery " AND item_text LIKE '%' || ? || '%' " (Only search)
| otherwise = searchQuery " AND LOWER(item_text) LIKE '%' || LOWER(?) || '%' " (Only search)
where
searchQuery :: ToRow p' => Query -> p' -> IO [ChatItemId]
searchQuery c' p' =
@ -1313,7 +1361,7 @@ getGroupMinUnreadId_ db user g contentFilter =
queryUnreadGroupItems db user g contentFilter baseQuery orderLimit
where
baseQuery = "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? "
orderLimit = " ORDER BY item_ts ASC, chat_item_id ASC LIMIT 1"
orderLimit = " ORDER BY item_ts ASC, chat_item_id ASC LIMIT 1"
getGroupUnreadCount_ :: DB.Connection -> User -> GroupInfo -> Maybe ContentFilter -> IO Int
getGroupUnreadCount_ db user g contentFilter =
@ -1372,7 +1420,7 @@ getGroupNavInfo_ db User {userId} GroupInfo {groupId} afterCI = do
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_status = ?
AND item_ts = ? AND chat_item_id > ?
)
) ci
|]
( (userId, groupId, CISRcvNew, chatItemTs afterCI)
:. (userId, groupId, CISRcvNew, chatItemTs afterCI, cChatItemId afterCI)
@ -1394,7 +1442,7 @@ getGroupNavInfo_ db User {userId} GroupInfo {groupId} afterCI = do
FROM chat_items
WHERE user_id = ? AND group_id = ?
AND item_ts = ? AND chat_item_id > ?
)
) ci
|]
( (userId, groupId, chatItemTs afterCI)
:. (userId, groupId, chatItemTs afterCI, cChatItemId afterCI)
@ -1428,7 +1476,7 @@ getLocalChatItemIdsLast_ db User {userId} NoteFolder {noteFolderId} count search
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
@ -1476,7 +1524,7 @@ getLocalCIsAfter_ db User {userId} NoteFolder {noteFolderId} afterCI count searc
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
@ -1499,7 +1547,7 @@ getLocalCIsBefore_ db User {userId} NoteFolder {noteFolderId} beforeCI count sea
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
@ -1591,7 +1639,7 @@ getLocalNavInfo_ db User {userId} NoteFolder {noteFolderId} afterCI = do
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
AND created_at = ? AND chat_item_id > ?
)
) ci
|]
( (userId, noteFolderId, CISRcvNew, ciCreatedAt afterCI)
:. (userId, noteFolderId, CISRcvNew, ciCreatedAt afterCI, cChatItemId afterCI)
@ -1613,7 +1661,7 @@ getLocalNavInfo_ db User {userId} NoteFolder {noteFolderId} afterCI = do
FROM chat_items
WHERE user_id = ? AND note_folder_id = ?
AND created_at = ? AND chat_item_id > ?
)
) ci
|]
( (userId, noteFolderId, ciCreatedAt afterCI)
:. (userId, noteFolderId, ciCreatedAt afterCI, cChatItemId afterCI)
@ -1763,21 +1811,21 @@ updateLocalChatItemsRead db User {userId} noteFolderId = do
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe ACIFileStatus, Maybe FileProtocol)
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool)
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe BoolInt)
type ChatItemForwardedFromRow = (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)
type ChatItemRow =
(Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe Bool, Maybe SharedMsgId)
:. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime)
(Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe BoolInt, Maybe SharedMsgId)
:. (Int, Maybe UTCTime, Maybe BoolInt, UTCTime, UTCTime)
:. ChatItemForwardedFromRow
:. ChatItemModeRow
:. MaybeCIFIleRow
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe BoolInt)
toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect)
toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent
toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction . unBI <$> quotedSent
where
direction sent = if sent then CIQDirectSnd else CIQDirectRcv
@ -1818,9 +1866,9 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
let itemDeleted' = case itemDeleted of
DBCINotDeleted -> Nothing
_ -> Just (CIDeleted @'CTDirect deletedTs)
itemEdited' = fromMaybe False itemEdited
itemEdited' = maybe False unBI itemEdited
itemForwarded = toCIForwardedFrom forwardedFromRow
in mkCIMeta itemId content itemText status sentViaProxy sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) currentTs itemTs Nothing createdAt updatedAt
ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
@ -1837,9 +1885,9 @@ type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_
where
direction (Just True) _ = Just CIQGroupSnd
direction (Just False) (Just member) = Just . CIQGroupRcv $ Just member
direction (Just False) Nothing = Just $ CIQGroupRcv Nothing
direction (Just (BI True)) _ = Just CIQGroupSnd
direction (Just (BI False)) (Just member) = Just . CIQGroupRcv $ Just member
direction (Just (BI False)) Nothing = Just $ CIQGroupRcv Nothing
direction _ _ = Nothing
-- this function can be changed so it never fails, not only avoid failure on invalid json
@ -1880,9 +1928,9 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
DBCIBlocked -> Just (CIBlocked deletedTs)
DBCIBlockedByAdmin -> Just (CIBlockedByAdmin deletedTs)
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
itemEdited' = fromMaybe False itemEdited
itemEdited' = maybe False unBI itemEdited
itemForwarded = toCIForwardedFrom forwardedFromRow
in mkCIMeta itemId content itemText status sentViaProxy sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) currentTs itemTs forwardedByMember createdAt updatedAt
ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
@ -1912,7 +1960,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
[sql|
SELECT chat_item_id, contact_id, group_id, note_folder_id
FROM chat_items
WHERE user_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT ?
|]
@ -1923,7 +1971,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
[sql|
SELECT chat_item_id, contact_id, group_id, note_folder_id
FROM chat_items
WHERE user_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?))
ORDER BY item_ts ASC, chat_item_id ASC
LIMIT ?
@ -1936,7 +1984,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
[sql|
SELECT chat_item_id, contact_id, group_id, note_folder_id
FROM chat_items
WHERE user_id = ? AND item_text LIKE '%' || ? || '%'
WHERE user_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (item_ts < ? OR (item_ts = ? AND chat_item_id < ?))
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT ?
@ -1992,7 +2040,7 @@ updateDirectChatItemStatus db user@User {userId} ct@Contact {contactId} itemId i
setDirectSndChatItemViaProxy :: DB.Connection -> User -> Contact -> ChatItem 'CTDirect 'MDSnd -> Bool -> IO (ChatItem 'CTDirect 'MDSnd)
setDirectSndChatItemViaProxy db User {userId} Contact {contactId} ci viaProxy = do
DB.execute db "UPDATE chat_items SET via_proxy = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?" (viaProxy, userId, contactId, chatItemId' ci)
DB.execute db "UPDATE chat_items SET via_proxy = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?" (BI viaProxy, userId, contactId, chatItemId' ci)
pure ci {meta = (meta ci) {sentViaProxy = Just viaProxy}}
updateDirectChatItem :: MsgDirectionI d => DB.Connection -> User -> Contact -> ChatItemId -> CIContent d -> Bool -> Bool -> Maybe CITimed -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
@ -2044,7 +2092,7 @@ updateDirectChatItem_ db userId contactId ChatItem {meta, content} msgId_ = do
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
|]
((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, contactId, itemId))
((content, itemText, itemStatus, BI itemDeleted', itemDeletedTs', BI itemEdited, BI <$> itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, contactId, itemId))
forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId updatedAt
addInitialAndNewCIVersions :: DB.Connection -> ChatItemId -> (UTCTime, MsgContent) -> (UTCTime, MsgContent) -> IO ()
@ -2235,7 +2283,7 @@ updateGroupChatItem_ db User {userId} groupId ChatItem {content, meta} msgId_ =
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|]
((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, groupId, itemId))
((content, itemText, itemStatus, BI itemDeleted', itemDeletedTs', BI itemEdited, BI <$> itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, groupId, itemId))
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db itemId msgId updatedAt
deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
@ -2573,7 +2621,7 @@ updateLocalChatItem_ db userId noteFolderId ChatItem {meta, content} = do
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, updated_at = ?
WHERE user_id = ? AND note_folder_id = ? AND chat_item_id = ?
|]
((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, updatedAt) :. (userId, noteFolderId, itemId))
((content, itemText, itemStatus, BI itemDeleted', itemDeletedTs', BI itemEdited, updatedAt) :. (userId, noteFolderId, itemId))
deleteLocalChatItem :: DB.Connection -> User -> NoteFolder -> ChatItem 'CTLocal d -> IO ()
deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do
@ -2740,8 +2788,8 @@ deleteGroupCIReactions_ db g@GroupInfo {groupId} ci@ChatItem {meta = CIMeta {ite
"DELETE FROM chat_item_reactions WHERE group_id = ? AND shared_msg_id = ? AND item_member_id = ?"
(groupId, itemSharedMId, memberId)
toCIReaction :: (MsgReaction, Bool, Int) -> CIReactionCount
toCIReaction (reaction, userReacted, totalReacted) = CIReactionCount {reaction, userReacted, totalReacted}
toCIReaction :: (MsgReaction, BoolInt, Int) -> CIReactionCount
toCIReaction (reaction, BI userReacted, totalReacted) = CIReactionCount {reaction, userReacted, totalReacted}
getDirectReactions :: DB.Connection -> Contact -> SharedMsgId -> Bool -> IO [MsgReaction]
getDirectReactions db ct itemSharedMId sent =
@ -2753,7 +2801,7 @@ getDirectReactions db ct itemSharedMId sent =
FROM chat_item_reactions
WHERE contact_id = ? AND shared_msg_id = ? AND reaction_sent = ?
|]
(contactId' ct, itemSharedMId, sent)
(contactId' ct, itemSharedMId, BI sent)
setDirectReaction :: DB.Connection -> Contact -> SharedMsgId -> Bool -> MsgReaction -> Bool -> MessageId -> UTCTime -> IO ()
setDirectReaction db ct itemSharedMId sent reaction add msgId reactionTs
@ -2765,7 +2813,7 @@ setDirectReaction db ct itemSharedMId sent reaction add msgId reactionTs
(contact_id, shared_msg_id, reaction_sent, reaction, created_by_msg_id, reaction_ts)
VALUES (?,?,?,?,?,?)
|]
(contactId' ct, itemSharedMId, sent, reaction, msgId, reactionTs)
(contactId' ct, itemSharedMId, BI sent, reaction, msgId, reactionTs)
| otherwise =
DB.execute
db
@ -2773,7 +2821,7 @@ setDirectReaction db ct itemSharedMId sent reaction add msgId reactionTs
DELETE FROM chat_item_reactions
WHERE contact_id = ? AND shared_msg_id = ? AND reaction_sent = ? AND reaction = ?
|]
(contactId' ct, itemSharedMId, sent, reaction)
(contactId' ct, itemSharedMId, BI sent, reaction)
getGroupReactions :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> Bool -> IO [MsgReaction]
getGroupReactions db GroupInfo {groupId} m itemMemberId itemSharedMId sent =
@ -2785,7 +2833,7 @@ getGroupReactions db GroupInfo {groupId} m itemMemberId itemSharedMId sent =
FROM chat_item_reactions
WHERE group_id = ? AND group_member_id = ? AND item_member_id = ? AND shared_msg_id = ? AND reaction_sent = ?
|]
(groupId, groupMemberId' m, itemMemberId, itemSharedMId, sent)
(groupId, groupMemberId' m, itemMemberId, itemSharedMId, BI sent)
setGroupReaction :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> Bool -> MsgReaction -> Bool -> MessageId -> UTCTime -> IO ()
setGroupReaction db GroupInfo {groupId} m itemMemberId itemSharedMId sent reaction add msgId reactionTs
@ -2797,7 +2845,7 @@ setGroupReaction db GroupInfo {groupId} m itemMemberId itemSharedMId sent reacti
(group_id, group_member_id, item_member_id, shared_msg_id, reaction_sent, reaction, created_by_msg_id, reaction_ts)
VALUES (?,?,?,?,?,?,?,?)
|]
(groupId, groupMemberId' m, itemMemberId, itemSharedMId, sent, reaction, msgId, reactionTs)
(groupId, groupMemberId' m, itemMemberId, itemSharedMId, BI sent, reaction, msgId, reactionTs)
| otherwise =
DB.execute
db
@ -2805,7 +2853,7 @@ setGroupReaction db GroupInfo {groupId} m itemMemberId itemSharedMId sent reacti
DELETE FROM chat_item_reactions
WHERE group_id = ? AND group_member_id = ? AND shared_msg_id = ? AND item_member_id = ? AND reaction_sent = ? AND reaction = ?
|]
(groupId, groupMemberId' m, itemSharedMId, itemMemberId, sent, reaction)
(groupId, groupMemberId' m, itemSharedMId, itemMemberId, BI sent, reaction)
getReactionMembers :: DB.Connection -> VersionRangeChat -> User -> GroupId -> SharedMsgId -> MsgReaction -> IO [MemberReaction]
getReactionMembers db vr user groupId itemSharedMId reaction = do
@ -2974,7 +3022,7 @@ setGroupSndViaProxy db itemId memberId viaProxy =
SET via_proxy = ?
WHERE chat_item_id = ? AND group_member_id = ?
|]
(viaProxy, itemId, memberId)
(BI viaProxy, itemId, memberId)
getGroupSndStatuses :: DB.Connection -> ChatItemId -> IO [MemberDeliveryStatus]
getGroupSndStatuses db itemId =
@ -2989,7 +3037,7 @@ getGroupSndStatuses db itemId =
(Only itemId)
where
memStatus (groupMemberId, memberDeliveryStatus, sentViaProxy) =
MemberDeliveryStatus {groupMemberId, memberDeliveryStatus, sentViaProxy}
MemberDeliveryStatus {groupMemberId, memberDeliveryStatus, sentViaProxy = unBI <$> sentViaProxy}
getGroupSndStatusCounts :: DB.Connection -> ChatItemId -> IO [(GroupSndStatus, Int)]
getGroupSndStatusCounts db itemId =

17
src/Simplex/Chat/Store/NoteFolders.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@ -10,13 +11,19 @@ module Simplex.Chat.Store.NoteFolders where
import Control.Monad.Except (ExceptT (..), throwError)
import Control.Monad.IO.Class (liftIO)
import Data.Time (getCurrentTime)
import Database.SQLite.Simple (Only (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Store.Shared (StoreError (..))
import Simplex.Chat.Types (NoteFolder (..), NoteFolderId, User (..))
import Simplex.Messaging.Agent.Protocol (UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..))
import Database.SQLite.Simple.QQ (sql)
#endif
createNoteFolder :: DB.Connection -> User -> ExceptT StoreError IO ()
createNoteFolder db User {userId} = do
@ -43,13 +50,13 @@ getNoteFolder db User {userId} noteFolderId =
|]
(userId, noteFolderId)
where
toNoteFolder (createdAt, updatedAt, chatTs, favorite, unread) =
toNoteFolder (createdAt, updatedAt, chatTs, BI favorite, BI unread) =
NoteFolder {noteFolderId, userId, createdAt, updatedAt, chatTs, favorite, unread}
updateNoteFolderUnreadChat :: DB.Connection -> User -> NoteFolder -> Bool -> IO ()
updateNoteFolderUnreadChat db User {userId} NoteFolder {noteFolderId} unreadChat = do
updatedAt <- getCurrentTime
DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND note_folder_id = ?" (unreadChat, updatedAt, userId, noteFolderId)
DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND note_folder_id = ?" (BI unreadChat, updatedAt, userId, noteFolderId)
deleteNoteFolderFiles :: DB.Connection -> UserId -> NoteFolder -> IO ()
deleteNoteFolderFiles db userId NoteFolder {noteFolderId} = do

19
src/Simplex/Chat/Store/Postgres/Migrations.hs Normal file
View file

@ -0,0 +1,19 @@
{-# LANGUAGE NamedFieldPuns #-}
module Simplex.Chat.Store.Postgres.Migrations (migrations) where
import Data.List (sortOn)
import Data.Text (Text)
import Simplex.Chat.Store.Postgres.Migrations.M20241220_initial
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
schemaMigrations =
[ ("20241220_initial", m20241220_initial, Nothing)
]
-- | The list of migrations in ascending order by date
migrations :: [Migration]
migrations = sortOn name $ map migration schemaMigrations
where
migration (name, up, down) = Migration {name, up, down}

1012
src/Simplex/Chat/Store/Postgres/Migrations/M20241220_initial.hs Normal file
View file

File diff suppressed because it is too large Load diff

109
src/Simplex/Chat/Store/Profiles.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
@ -86,8 +87,6 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Database.SQLite.Simple (NamedParam (..), Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Call
import Simplex.Chat.Messages
import Simplex.Chat.Operators
@ -101,7 +100,8 @@ import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding.String
@ -109,6 +109,13 @@ import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode)
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
#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
createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User
createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
@ -124,7 +131,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
DB.execute
db
"INSERT INTO users (agent_user_id, local_display_name, active_user, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,?,0,?,?,?,?,?)"
(auId, displayName, activeUser, order, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, currentTs, currentTs)
(auId, displayName, BI activeUser, order, BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, currentTs, currentTs)
userId <- insertedRowId db
DB.execute
db
@ -138,10 +145,10 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
DB.execute
db
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)"
(profileId, displayName, userId, True, currentTs, currentTs, currentTs)
(profileId, displayName, userId, BI True, currentTs, currentTs, currentTs)
contactId <- insertedRowId db
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, order, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing, Nothing, Nothing)
pure $ toUser $ (userId, auId, contactId, profileId, BI activeUser, order, displayName, fullName, image, Nothing, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, Nothing, Nothing, Nothing, Nothing)
getUsersInfo :: DB.Connection -> IO [UserInfo]
getUsersInfo db = getUsers db >>= mapM getUserInfo
@ -253,7 +260,7 @@ updateUserPrivacy db User {userId, showNtfs, viewPwdHash} =
SET view_pwd_hash = ?, view_pwd_salt = ?, show_ntfs = ?
WHERE user_id = ?
|]
(hashSalt viewPwdHash :. (showNtfs, userId))
(hashSalt viewPwdHash :. (BI showNtfs, userId))
where
hashSalt = L.unzip . fmap (\UserPwdHash {hash, salt} -> (hash, salt))
@ -262,16 +269,16 @@ updateAllContactReceipts db onOff =
DB.execute
db
"UPDATE users SET send_rcpts_contacts = ?, send_rcpts_small_groups = ? WHERE view_pwd_hash IS NULL"
(onOff, onOff)
(BI onOff, BI onOff)
updateUserContactReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserContactReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (enable, userId)
DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (BI enable, userId)
when clearOverrides $ DB.execute_ db "UPDATE contacts SET send_rcpts = NULL"
updateUserGroupReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserGroupReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
DB.execute db "UPDATE users SET send_rcpts_small_groups = ? WHERE user_id = ?" (enable, userId)
DB.execute db "UPDATE users SET send_rcpts_small_groups = ? WHERE user_id = ?" (BI enable, userId)
when clearOverrides $ DB.execute_ db "UPDATE groups SET send_rcpts = NULL"
updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
@ -403,21 +410,21 @@ deleteUserAddress db user@User {userId} = do
)
|]
(Only userId)
DB.executeNamed
DB.execute
db
[sql|
DELETE FROM display_names
WHERE user_id = :user_id
WHERE user_id = ?
AND local_display_name in (
SELECT cr.local_display_name
FROM contact_requests cr
JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
WHERE uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL
)
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = :user_id)
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
|]
[":user_id" := userId]
DB.executeNamed
(userId, userId, userId)
DB.execute
db
[sql|
DELETE FROM contact_profiles
@ -425,10 +432,10 @@ deleteUserAddress db user@User {userId} = do
SELECT cr.contact_profile_id
FROM contact_requests cr
JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
WHERE uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL
)
|]
[":user_id" := userId]
(Only userId)
void $ setUserProfileContactLink db user Nothing
DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL" (Only userId)
@ -455,8 +462,8 @@ $(J.deriveJSON defaultJSON ''AutoAccept)
$(J.deriveJSON defaultJSON ''UserContactLink)
toUserContactLink :: (ConnReqContact, Bool, Bool, IncognitoEnabled, Maybe MsgContent) -> UserContactLink
toUserContactLink (connReq, autoAccept, businessAddress, acceptIncognito, autoReply) =
toUserContactLink :: (ConnReqContact, BoolInt, BoolInt, BoolInt, Maybe MsgContent) -> UserContactLink
toUserContactLink (connReq, BI autoAccept, BI businessAddress, BI acceptIncognito, autoReply) =
UserContactLink connReq $
if autoAccept then Just AutoAccept {businessAddress, acceptIncognito, autoReply} else Nothing
@ -528,8 +535,8 @@ updateUserAddressAutoAccept db user@User {userId} autoAccept = do
|]
(ucl :. Only userId)
ucl = case autoAccept of
Just AutoAccept {businessAddress, acceptIncognito, autoReply} -> (True, businessAddress, acceptIncognito, autoReply)
_ -> (False, False, False, Nothing)
Just AutoAccept {businessAddress, acceptIncognito, autoReply} -> (BI True, BI businessAddress, BI acceptIncognito, autoReply)
_ -> (BI False, BI False, BI False, Nothing)
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> IO [UserServer p]
getProtocolServers db p User {userId} =
@ -543,10 +550,10 @@ getProtocolServers db p User {userId} =
|]
(userId, decodeLatin1 $ strEncode p)
where
toUserServer :: (DBEntityId, NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> UserServer p
toUserServer (serverId, host, port, keyHash, auth_, preset, tested, enabled) =
toUserServer :: (DBEntityId, NonEmpty TransportHost, String, C.KeyHash, Maybe Text, BoolInt, Maybe BoolInt, BoolInt) -> UserServer p
toUserServer (serverId, host, port, keyHash, auth_, BI preset, tested, BI enabled) =
let server = ProtoServerWithAuth (ProtocolServer p host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
in UserServer {serverId, server, preset, tested, enabled, deleted = False}
in UserServer {serverId, server, preset, tested = unBI <$> tested, enabled, deleted = False}
insertProtocolServer :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> UTCTime -> NewUserServer p -> IO (UserServer p)
insertProtocolServer db p User {userId} ts srv@UserServer {server, preset, tested, enabled} = do
@ -557,7 +564,7 @@ insertProtocolServer db p User {userId} ts srv@UserServer {server, preset, teste
(protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|]
(serverColumns p server :. (preset, tested, enabled, userId, ts, ts))
(serverColumns p server :. (BI preset, BI <$> tested, BI enabled, userId, ts, ts))
sId <- insertedRowId db
pure (srv :: NewUserServer p) {serverId = DBEntityId sId}
@ -571,7 +578,7 @@ updateProtocolServer db p ts UserServer {serverId, server, preset, tested, enabl
preset = ?, tested = ?, enabled = ?, updated_at = ?
WHERE smp_server_id = ?
|]
(serverColumns p server :. (preset, tested, enabled, ts, serverId))
(serverColumns p server :. (BI preset, BI <$> tested, BI enabled, ts, serverId))
serverColumns :: ProtocolTypeI p => SProtocolType p -> ProtoServerWithAuth p -> (Text, NonEmpty TransportHost, String, C.KeyHash, Maybe Text)
serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_) =
@ -611,7 +618,7 @@ updateServerOperator db currentTs ServerOperator {operatorId, enabled, smpRoles,
SET enabled = ?, smp_role_storage = ?, smp_role_proxy = ?, xftp_role_storage = ?, xftp_role_proxy = ?, updated_at = ?
WHERE server_operator_id = ?
|]
(enabled, storage smpRoles, proxy smpRoles, storage xftpRoles, proxy xftpRoles, currentTs, operatorId)
(BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles), currentTs, operatorId)
getUpdateServerOperators :: DB.Connection -> NonEmpty PresetOperator -> Bool -> IO [(Maybe PresetOperator, Maybe ServerOperator)]
getUpdateServerOperators db presetOps newUser = do
@ -649,7 +656,7 @@ getUpdateServerOperators db presetOps newUser = do
SET trade_name = ?, legal_name = ?, server_domains = ?, enabled = ?, smp_role_storage = ?, smp_role_proxy = ?, xftp_role_storage = ?, xftp_role_proxy = ?
WHERE server_operator_id = ?
|]
(tradeName, legalName, T.intercalate "," serverDomains, enabled, storage smpRoles, proxy smpRoles, storage xftpRoles, proxy xftpRoles, operatorId)
(tradeName, legalName, T.intercalate "," serverDomains, BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles), operatorId)
insertOperator :: NewServerOperator -> IO ServerOperator
insertOperator op@ServerOperator {operatorTag, tradeName, legalName, serverDomains, enabled, smpRoles, xftpRoles} = do
DB.execute
@ -659,7 +666,7 @@ getUpdateServerOperators db presetOps newUser = do
(server_operator_tag, trade_name, legal_name, server_domains, enabled, smp_role_storage, smp_role_proxy, xftp_role_storage, xftp_role_proxy)
VALUES (?,?,?,?,?,?,?,?,?)
|]
(operatorTag, tradeName, legalName, T.intercalate "," serverDomains, enabled, storage smpRoles, proxy smpRoles, storage xftpRoles, proxy xftpRoles)
(operatorTag, tradeName, legalName, T.intercalate "," serverDomains, BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles))
opId <- insertedRowId db
pure op {operatorId = DBEntityId opId}
autoAcceptConditions op UsageConditions {conditionsCommit} now =
@ -677,8 +684,8 @@ serverOperatorQuery =
getServerOperators_ :: DB.Connection -> IO [ServerOperator]
getServerOperators_ db = map toServerOperator <$> DB.query_ db serverOperatorQuery
toServerOperator :: (DBEntityId, Maybe OperatorTag, Text, Maybe Text, Text, Bool) :. (Bool, Bool) :. (Bool, Bool) -> ServerOperator
toServerOperator ((operatorId, operatorTag, tradeName, legalName, domains, enabled) :. smpRoles' :. xftpRoles') =
toServerOperator :: (DBEntityId, Maybe OperatorTag, Text, Maybe Text, Text, BoolInt) :. (BoolInt, BoolInt) :. (BoolInt, BoolInt) -> ServerOperator
toServerOperator ((operatorId, operatorTag, tradeName, legalName, domains, BI enabled) :. smpRoles' :. xftpRoles') =
ServerOperator
{ operatorId,
operatorTag,
@ -691,7 +698,7 @@ toServerOperator ((operatorId, operatorTag, tradeName, legalName, domains, enabl
xftpRoles = serverRoles xftpRoles'
}
where
serverRoles (storage, proxy) = ServerRoles {storage, proxy}
serverRoles (BI storage, BI proxy) = ServerRoles {storage, proxy}
getOperatorConditions_ :: DB.Connection -> ServerOperator -> UsageConditions -> Maybe UsageConditions -> UTCTime -> IO ConditionsAcceptance
getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {conditionsCommit = currentCommit, createdAt, notifiedAt} latestAcceptedConds_ now = do
@ -711,7 +718,7 @@ getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {condition
|]
(Only operatorId)
pure $ case operatorAcceptedConds_ of
Just (operatorCommit, acceptedAt_, autoAccept)
Just (operatorCommit, acceptedAt_, BI autoAccept)
| operatorCommit /= latestAcceptedCommit -> CARequired Nothing -- TODO should we consider this operator disabled?
| currentCommit /= latestAcceptedCommit -> CARequired $ conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt)
| otherwise -> CAAccepted acceptedAt_ autoAccept
@ -767,23 +774,23 @@ acceptConditions db condId opIds acceptedAt = do
acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> UTCTime -> Bool -> IO ()
acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt autoAccepted = do
acceptedAt_ :: Maybe (Maybe UTCTime) <- maybeFirstRow fromOnly $ DB.query db "SELECT accepted_at FROM operator_usage_conditions WHERE server_operator_id = ? AND conditions_commit == ?" (operatorId, conditionsCommit)
acceptedAt_ :: Maybe (Maybe UTCTime) <- maybeFirstRow fromOnly $ DB.query db "SELECT accepted_at FROM operator_usage_conditions WHERE server_operator_id = ? AND conditions_commit = ?" (operatorId, conditionsCommit)
case acceptedAt_ of
Just Nothing ->
DB.execute
db
(q <> "ON CONFLICT (server_operator_id, conditions_commit) DO UPDATE SET accepted_at = ?, auto_accepted = ?")
(operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted, acceptedAt, autoAccepted)
Just (Just _) ->
DB.execute
db
(q <> "ON CONFLICT (server_operator_id, conditions_commit) DO NOTHING")
(operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted)
Nothing ->
DB.execute
db
q
(operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted)
Just Nothing ->
DB.execute
db
(q <> "ON CONFLICT (server_operator_id, conditions_commit) DO UPDATE SET accepted_at = ?, auto_accepted = ?")
(operatorId, operatorTag, conditionsCommit, acceptedAt, BI autoAccepted, acceptedAt, BI autoAccepted)
Just (Just _) ->
DB.execute
db
(q <> "ON CONFLICT (server_operator_id, conditions_commit) DO NOTHING")
(operatorId, operatorTag, conditionsCommit, acceptedAt, BI autoAccepted)
Nothing ->
DB.execute
db
q
(operatorId, operatorTag, conditionsCommit, acceptedAt, BI autoAccepted)
where
q =
[sql|
@ -820,7 +827,7 @@ setUserServers' db user@User {userId} ts UpdatedUserOperatorServers {operator, s
| deleted -> pure Nothing
| otherwise -> Just <$> insertProtocolServer db p user ts s
DBEntityId srvId
| deleted -> Nothing <$ DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND smp_server_id = ? AND preset = ?" (userId, srvId, False)
| deleted -> Nothing <$ DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND smp_server_id = ? AND preset = ?" (userId, srvId, BI False)
| otherwise -> Just s <$ updateProtocolServer db p ts s
createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()

19
src/Simplex/Chat/Store/Remote.hs
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

240
src/Simplex/Chat/Store/Migrations.hs → src/Simplex/Chat/Store/SQLite/Migrations.hs
View file

@ -1,128 +1,128 @@
{-# LANGUAGE NamedFieldPuns #-}
module Simplex.Chat.Store.Migrations (migrations) where
module Simplex.Chat.Store.SQLite.Migrations (migrations) where
import Data.List (sortOn)
import Database.SQLite.Simple (Query (..))
import Simplex.Chat.Migrations.M20220101_initial
import Simplex.Chat.Migrations.M20220122_v1_1
import Simplex.Chat.Migrations.M20220205_chat_item_status
import Simplex.Chat.Migrations.M20220210_deduplicate_contact_requests
import Simplex.Chat.Migrations.M20220224_messages_fks
import Simplex.Chat.Migrations.M20220301_smp_servers
import Simplex.Chat.Migrations.M20220302_profile_images
import Simplex.Chat.Migrations.M20220304_msg_quotes
import Simplex.Chat.Migrations.M20220321_chat_item_edited
import Simplex.Chat.Migrations.M20220404_files_status_fields
import Simplex.Chat.Migrations.M20220514_profiles_user_id
import Simplex.Chat.Migrations.M20220626_auto_reply
import Simplex.Chat.Migrations.M20220702_calls
import Simplex.Chat.Migrations.M20220715_groups_chat_item_id
import Simplex.Chat.Migrations.M20220811_chat_items_indices
import Simplex.Chat.Migrations.M20220812_incognito_profiles
import Simplex.Chat.Migrations.M20220818_chat_notifications
import Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id
import Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items
import Simplex.Chat.Migrations.M20220824_profiles_local_alias
import Simplex.Chat.Migrations.M20220909_commands
import Simplex.Chat.Migrations.M20220926_connection_alias
import Simplex.Chat.Migrations.M20220928_settings
import Simplex.Chat.Migrations.M20221001_shared_msg_id_indices
import Simplex.Chat.Migrations.M20221003_delete_broken_integrity_error_chat_items
import Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
import Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
import Simplex.Chat.Migrations.M20221012_inline_files
import Simplex.Chat.Migrations.M20221019_unread_chat
import Simplex.Chat.Migrations.M20221021_auto_accept__group_links
import Simplex.Chat.Migrations.M20221024_contact_used
import Simplex.Chat.Migrations.M20221025_chat_settings
import Simplex.Chat.Migrations.M20221029_group_link_id
import Simplex.Chat.Migrations.M20221112_server_password
import Simplex.Chat.Migrations.M20221115_server_cfg
import Simplex.Chat.Migrations.M20221129_delete_group_feature_items
import Simplex.Chat.Migrations.M20221130_delete_item_deleted
import Simplex.Chat.Migrations.M20221209_verified_connection
import Simplex.Chat.Migrations.M20221210_idxs
import Simplex.Chat.Migrations.M20221211_group_description
import Simplex.Chat.Migrations.M20221212_chat_items_timed
import Simplex.Chat.Migrations.M20221214_live_message
import Simplex.Chat.Migrations.M20221222_chat_ts
import Simplex.Chat.Migrations.M20221223_idx_chat_items_item_status
import Simplex.Chat.Migrations.M20221230_idxs
import Simplex.Chat.Migrations.M20230107_connections_auth_err_counter
import Simplex.Chat.Migrations.M20230111_users_agent_user_id
import Simplex.Chat.Migrations.M20230117_fkey_indexes
import Simplex.Chat.Migrations.M20230118_recreate_smp_servers
import Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
import Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
import Simplex.Chat.Migrations.M20230303_group_link_role
import Simplex.Chat.Migrations.M20230317_hidden_profiles
import Simplex.Chat.Migrations.M20230318_file_description
import Simplex.Chat.Migrations.M20230321_agent_file_deleted
import Simplex.Chat.Migrations.M20230328_files_protocol
import Simplex.Chat.Migrations.M20230402_protocol_servers
import Simplex.Chat.Migrations.M20230411_extra_xftp_file_descriptions
import Simplex.Chat.Migrations.M20230420_rcv_files_to_receive
import Simplex.Chat.Migrations.M20230422_profile_contact_links
import Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
import Simplex.Chat.Migrations.M20230505_chat_item_versions
import Simplex.Chat.Migrations.M20230511_reactions
import Simplex.Chat.Migrations.M20230519_item_deleted_ts
import Simplex.Chat.Migrations.M20230526_indexes
import Simplex.Chat.Migrations.M20230529_indexes
import Simplex.Chat.Migrations.M20230608_deleted_contacts
import Simplex.Chat.Migrations.M20230618_favorite_chats
import Simplex.Chat.Migrations.M20230621_chat_item_moderations
import Simplex.Chat.Migrations.M20230705_delivery_receipts
import Simplex.Chat.Migrations.M20230721_group_snd_item_statuses
import Simplex.Chat.Migrations.M20230814_indexes
import Simplex.Chat.Migrations.M20230827_file_encryption
import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
import Simplex.Chat.Migrations.M20230913_member_contacts
import Simplex.Chat.Migrations.M20230914_member_probes
import Simplex.Chat.Migrations.M20230926_contact_status
import Simplex.Chat.Migrations.M20231002_conn_initiated
import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
import Simplex.Chat.Migrations.M20231010_member_settings
import Simplex.Chat.Migrations.M20231019_indexes
import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
import Simplex.Chat.Migrations.M20231107_indexes
import Simplex.Chat.Migrations.M20231113_group_forward
import Simplex.Chat.Migrations.M20231114_remote_control
import Simplex.Chat.Migrations.M20231126_remote_ctrl_address
import Simplex.Chat.Migrations.M20231207_chat_list_pagination
import Simplex.Chat.Migrations.M20231214_item_content_tag
import Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
import Simplex.Chat.Migrations.M20240102_note_folders
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.Chat.Migrations.M20240226_users_restrict
import Simplex.Chat.Migrations.M20240228_pq
import Simplex.Chat.Migrations.M20240313_drop_agent_ack_cmd_id
import Simplex.Chat.Migrations.M20240324_custom_data
import Simplex.Chat.Migrations.M20240402_item_forwarded
import Simplex.Chat.Migrations.M20240430_ui_theme
import Simplex.Chat.Migrations.M20240501_chat_deleted
import Simplex.Chat.Migrations.M20240510_chat_items_via_proxy
import Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays
import Simplex.Chat.Migrations.M20240528_quota_err_counter
import Simplex.Chat.Migrations.M20240827_calls_uuid
import Simplex.Chat.Migrations.M20240920_user_order
import Simplex.Chat.Migrations.M20241008_indexes
import Simplex.Chat.Migrations.M20241010_contact_requests_contact_id
import Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id
import Simplex.Chat.Migrations.M20241027_server_operators
import Simplex.Chat.Migrations.M20241125_indexes
import Simplex.Chat.Migrations.M20241128_business_chats
import Simplex.Chat.Migrations.M20241205_business_chat_members
import Simplex.Chat.Migrations.M20241222_operator_conditions
import Simplex.Chat.Migrations.M20241223_chat_tags
import Simplex.Chat.Migrations.M20241230_reports
import Simplex.Chat.Migrations.M20250105_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20220101_initial
import Simplex.Chat.Store.SQLite.Migrations.M20220122_v1_1
import Simplex.Chat.Store.SQLite.Migrations.M20220205_chat_item_status
import Simplex.Chat.Store.SQLite.Migrations.M20220210_deduplicate_contact_requests
import Simplex.Chat.Store.SQLite.Migrations.M20220224_messages_fks
import Simplex.Chat.Store.SQLite.Migrations.M20220301_smp_servers
import Simplex.Chat.Store.SQLite.Migrations.M20220302_profile_images
import Simplex.Chat.Store.SQLite.Migrations.M20220304_msg_quotes
import Simplex.Chat.Store.SQLite.Migrations.M20220321_chat_item_edited
import Simplex.Chat.Store.SQLite.Migrations.M20220404_files_status_fields
import Simplex.Chat.Store.SQLite.Migrations.M20220514_profiles_user_id
import Simplex.Chat.Store.SQLite.Migrations.M20220626_auto_reply
import Simplex.Chat.Store.SQLite.Migrations.M20220702_calls
import Simplex.Chat.Store.SQLite.Migrations.M20220715_groups_chat_item_id
import Simplex.Chat.Store.SQLite.Migrations.M20220811_chat_items_indices
import Simplex.Chat.Store.SQLite.Migrations.M20220812_incognito_profiles
import Simplex.Chat.Store.SQLite.Migrations.M20220818_chat_notifications
import Simplex.Chat.Store.SQLite.Migrations.M20220822_groups_host_conn_custom_user_profile_id
import Simplex.Chat.Store.SQLite.Migrations.M20220823_delete_broken_group_event_chat_items
import Simplex.Chat.Store.SQLite.Migrations.M20220824_profiles_local_alias
import Simplex.Chat.Store.SQLite.Migrations.M20220909_commands
import Simplex.Chat.Store.SQLite.Migrations.M20220926_connection_alias
import Simplex.Chat.Store.SQLite.Migrations.M20220928_settings
import Simplex.Chat.Store.SQLite.Migrations.M20221001_shared_msg_id_indices
import Simplex.Chat.Store.SQLite.Migrations.M20221003_delete_broken_integrity_error_chat_items
import Simplex.Chat.Store.SQLite.Migrations.M20221004_idx_msg_deliveries_message_id
import Simplex.Chat.Store.SQLite.Migrations.M20221011_user_contact_links_group_id
import Simplex.Chat.Store.SQLite.Migrations.M20221012_inline_files
import Simplex.Chat.Store.SQLite.Migrations.M20221019_unread_chat
import Simplex.Chat.Store.SQLite.Migrations.M20221021_auto_accept__group_links
import Simplex.Chat.Store.SQLite.Migrations.M20221024_contact_used
import Simplex.Chat.Store.SQLite.Migrations.M20221025_chat_settings
import Simplex.Chat.Store.SQLite.Migrations.M20221029_group_link_id
import Simplex.Chat.Store.SQLite.Migrations.M20221112_server_password
import Simplex.Chat.Store.SQLite.Migrations.M20221115_server_cfg
import Simplex.Chat.Store.SQLite.Migrations.M20221129_delete_group_feature_items
import Simplex.Chat.Store.SQLite.Migrations.M20221130_delete_item_deleted
import Simplex.Chat.Store.SQLite.Migrations.M20221209_verified_connection
import Simplex.Chat.Store.SQLite.Migrations.M20221210_idxs
import Simplex.Chat.Store.SQLite.Migrations.M20221211_group_description
import Simplex.Chat.Store.SQLite.Migrations.M20221212_chat_items_timed
import Simplex.Chat.Store.SQLite.Migrations.M20221214_live_message
import Simplex.Chat.Store.SQLite.Migrations.M20221222_chat_ts
import Simplex.Chat.Store.SQLite.Migrations.M20221223_idx_chat_items_item_status
import Simplex.Chat.Store.SQLite.Migrations.M20221230_idxs
import Simplex.Chat.Store.SQLite.Migrations.M20230107_connections_auth_err_counter
import Simplex.Chat.Store.SQLite.Migrations.M20230111_users_agent_user_id
import Simplex.Chat.Store.SQLite.Migrations.M20230117_fkey_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20230118_recreate_smp_servers
import Simplex.Chat.Store.SQLite.Migrations.M20230129_drop_chat_items_group_idx
import Simplex.Chat.Store.SQLite.Migrations.M20230206_item_deleted_by_group_member_id
import Simplex.Chat.Store.SQLite.Migrations.M20230303_group_link_role
import Simplex.Chat.Store.SQLite.Migrations.M20230317_hidden_profiles
import Simplex.Chat.Store.SQLite.Migrations.M20230318_file_description
import Simplex.Chat.Store.SQLite.Migrations.M20230321_agent_file_deleted
import Simplex.Chat.Store.SQLite.Migrations.M20230328_files_protocol
import Simplex.Chat.Store.SQLite.Migrations.M20230402_protocol_servers
import Simplex.Chat.Store.SQLite.Migrations.M20230411_extra_xftp_file_descriptions
import Simplex.Chat.Store.SQLite.Migrations.M20230420_rcv_files_to_receive
import Simplex.Chat.Store.SQLite.Migrations.M20230422_profile_contact_links
import Simplex.Chat.Store.SQLite.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
import Simplex.Chat.Store.SQLite.Migrations.M20230505_chat_item_versions
import Simplex.Chat.Store.SQLite.Migrations.M20230511_reactions
import Simplex.Chat.Store.SQLite.Migrations.M20230519_item_deleted_ts
import Simplex.Chat.Store.SQLite.Migrations.M20230526_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20230529_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20230608_deleted_contacts
import Simplex.Chat.Store.SQLite.Migrations.M20230618_favorite_chats
import Simplex.Chat.Store.SQLite.Migrations.M20230621_chat_item_moderations
import Simplex.Chat.Store.SQLite.Migrations.M20230705_delivery_receipts
import Simplex.Chat.Store.SQLite.Migrations.M20230721_group_snd_item_statuses
import Simplex.Chat.Store.SQLite.Migrations.M20230814_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20230827_file_encryption
import Simplex.Chat.Store.SQLite.Migrations.M20230829_connections_chat_vrange
import Simplex.Chat.Store.SQLite.Migrations.M20230903_connections_to_subscribe
import Simplex.Chat.Store.SQLite.Migrations.M20230913_member_contacts
import Simplex.Chat.Store.SQLite.Migrations.M20230914_member_probes
import Simplex.Chat.Store.SQLite.Migrations.M20230926_contact_status
import Simplex.Chat.Store.SQLite.Migrations.M20231002_conn_initiated
import Simplex.Chat.Store.SQLite.Migrations.M20231009_via_group_link_uri_hash
import Simplex.Chat.Store.SQLite.Migrations.M20231010_member_settings
import Simplex.Chat.Store.SQLite.Migrations.M20231019_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20231030_xgrplinkmem_received
import Simplex.Chat.Store.SQLite.Migrations.M20231107_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20231113_group_forward
import Simplex.Chat.Store.SQLite.Migrations.M20231114_remote_control
import Simplex.Chat.Store.SQLite.Migrations.M20231126_remote_ctrl_address
import Simplex.Chat.Store.SQLite.Migrations.M20231207_chat_list_pagination
import Simplex.Chat.Store.SQLite.Migrations.M20231214_item_content_tag
import Simplex.Chat.Store.SQLite.Migrations.M20231215_recreate_msg_deliveries
import Simplex.Chat.Store.SQLite.Migrations.M20240102_note_folders
import Simplex.Chat.Store.SQLite.Migrations.M20240104_members_profile_update
import Simplex.Chat.Store.SQLite.Migrations.M20240115_block_member_for_all
import Simplex.Chat.Store.SQLite.Migrations.M20240122_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20240214_redirect_file_id
import Simplex.Chat.Store.SQLite.Migrations.M20240222_app_settings
import Simplex.Chat.Store.SQLite.Migrations.M20240226_users_restrict
import Simplex.Chat.Store.SQLite.Migrations.M20240228_pq
import Simplex.Chat.Store.SQLite.Migrations.M20240313_drop_agent_ack_cmd_id
import Simplex.Chat.Store.SQLite.Migrations.M20240324_custom_data
import Simplex.Chat.Store.SQLite.Migrations.M20240402_item_forwarded
import Simplex.Chat.Store.SQLite.Migrations.M20240430_ui_theme
import Simplex.Chat.Store.SQLite.Migrations.M20240501_chat_deleted
import Simplex.Chat.Store.SQLite.Migrations.M20240510_chat_items_via_proxy
import Simplex.Chat.Store.SQLite.Migrations.M20240515_rcv_files_user_approved_relays
import Simplex.Chat.Store.SQLite.Migrations.M20240528_quota_err_counter
import Simplex.Chat.Store.SQLite.Migrations.M20240827_calls_uuid
import Simplex.Chat.Store.SQLite.Migrations.M20240920_user_order
import Simplex.Chat.Store.SQLite.Migrations.M20241008_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20241010_contact_requests_contact_id
import Simplex.Chat.Store.SQLite.Migrations.M20241023_chat_item_autoincrement_id
import Simplex.Chat.Store.SQLite.Migrations.M20241027_server_operators
import Simplex.Chat.Store.SQLite.Migrations.M20241125_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20241128_business_chats
import Simplex.Chat.Store.SQLite.Migrations.M20241205_business_chat_members
import Simplex.Chat.Store.SQLite.Migrations.M20241222_operator_conditions
import Simplex.Chat.Store.SQLite.Migrations.M20241223_chat_tags
import Simplex.Chat.Store.SQLite.Migrations.M20241230_reports
import Simplex.Chat.Store.SQLite.Migrations.M20250105_indexes
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]

2
src/Simplex/Chat/Migrations/M20220101_initial.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220101_initial.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220101_initial where
module Simplex.Chat.Store.SQLite.Migrations.M20220101_initial where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220122_v1_1.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220122_v1_1.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220122_v1_1 where
module Simplex.Chat.Store.SQLite.Migrations.M20220122_v1_1 where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220205_chat_item_status.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220205_chat_item_status.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220205_chat_item_status where
module Simplex.Chat.Store.SQLite.Migrations.M20220205_chat_item_status where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220210_deduplicate_contact_requests.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220210_deduplicate_contact_requests.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220210_deduplicate_contact_requests where
module Simplex.Chat.Store.SQLite.Migrations.M20220210_deduplicate_contact_requests where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220224_messages_fks.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220224_messages_fks.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220224_messages_fks where
module Simplex.Chat.Store.SQLite.Migrations.M20220224_messages_fks where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220301_smp_servers.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220301_smp_servers.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220301_smp_servers where
module Simplex.Chat.Store.SQLite.Migrations.M20220301_smp_servers where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220302_profile_images.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220302_profile_images.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220302_profile_images where
module Simplex.Chat.Store.SQLite.Migrations.M20220302_profile_images where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220304_msg_quotes.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220304_msg_quotes.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220304_msg_quotes where
module Simplex.Chat.Store.SQLite.Migrations.M20220304_msg_quotes where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220321_chat_item_edited.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220321_chat_item_edited.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220321_chat_item_edited where
module Simplex.Chat.Store.SQLite.Migrations.M20220321_chat_item_edited where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220404_files_status_fields.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220404_files_status_fields.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220404_files_status_fields where
module Simplex.Chat.Store.SQLite.Migrations.M20220404_files_status_fields where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220514_profiles_user_id.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220514_profiles_user_id.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220514_profiles_user_id where
module Simplex.Chat.Store.SQLite.Migrations.M20220514_profiles_user_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220626_auto_reply.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220626_auto_reply.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220626_auto_reply where
module Simplex.Chat.Store.SQLite.Migrations.M20220626_auto_reply where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220702_calls.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220702_calls.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220702_calls where
module Simplex.Chat.Store.SQLite.Migrations.M20220702_calls where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220715_groups_chat_item_id.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220715_groups_chat_item_id.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220715_groups_chat_item_id where
module Simplex.Chat.Store.SQLite.Migrations.M20220715_groups_chat_item_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220811_chat_items_indices.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220811_chat_items_indices.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220811_chat_items_indices where
module Simplex.Chat.Store.SQLite.Migrations.M20220811_chat_items_indices where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220812_incognito_profiles.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220812_incognito_profiles.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220812_incognito_profiles where
module Simplex.Chat.Store.SQLite.Migrations.M20220812_incognito_profiles where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220818_chat_notifications.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220818_chat_notifications.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220818_chat_notifications where
module Simplex.Chat.Store.SQLite.Migrations.M20220818_chat_notifications where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220822_groups_host_conn_custom_user_profile_id.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220822_groups_host_conn_custom_user_profile_id.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id where
module Simplex.Chat.Store.SQLite.Migrations.M20220822_groups_host_conn_custom_user_profile_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220823_delete_broken_group_event_chat_items.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220823_delete_broken_group_event_chat_items.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items where
module Simplex.Chat.Store.SQLite.Migrations.M20220823_delete_broken_group_event_chat_items where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220824_profiles_local_alias.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220824_profiles_local_alias.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220824_profiles_local_alias where
module Simplex.Chat.Store.SQLite.Migrations.M20220824_profiles_local_alias where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220909_commands.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220909_commands.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220909_commands where
module Simplex.Chat.Store.SQLite.Migrations.M20220909_commands where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220926_connection_alias.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220926_connection_alias.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220926_connection_alias where
module Simplex.Chat.Store.SQLite.Migrations.M20220926_connection_alias where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20220928_settings.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20220928_settings.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220928_settings where
module Simplex.Chat.Store.SQLite.Migrations.M20220928_settings where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221001_shared_msg_id_indices.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221001_shared_msg_id_indices.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221001_shared_msg_id_indices where
module Simplex.Chat.Store.SQLite.Migrations.M20221001_shared_msg_id_indices where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221003_delete_broken_integrity_error_chat_items.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221003_delete_broken_integrity_error_chat_items.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221003_delete_broken_integrity_error_chat_items where
module Simplex.Chat.Store.SQLite.Migrations.M20221003_delete_broken_integrity_error_chat_items where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221004_idx_msg_deliveries_message_id.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221004_idx_msg_deliveries_message_id.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id where
module Simplex.Chat.Store.SQLite.Migrations.M20221004_idx_msg_deliveries_message_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221011_user_contact_links_group_id.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221011_user_contact_links_group_id.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221011_user_contact_links_group_id where
module Simplex.Chat.Store.SQLite.Migrations.M20221011_user_contact_links_group_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221012_inline_files.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221012_inline_files.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221012_inline_files where
module Simplex.Chat.Store.SQLite.Migrations.M20221012_inline_files where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221019_unread_chat.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221019_unread_chat.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221019_unread_chat where
module Simplex.Chat.Store.SQLite.Migrations.M20221019_unread_chat where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221021_auto_accept__group_links.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221021_auto_accept__group_links.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221021_auto_accept__group_links where
module Simplex.Chat.Store.SQLite.Migrations.M20221021_auto_accept__group_links where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221024_contact_used.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221024_contact_used.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221024_contact_used where
module Simplex.Chat.Store.SQLite.Migrations.M20221024_contact_used where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221025_chat_settings.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221025_chat_settings.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221025_chat_settings where
module Simplex.Chat.Store.SQLite.Migrations.M20221025_chat_settings where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221029_group_link_id.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221029_group_link_id.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221029_group_link_id where
module Simplex.Chat.Store.SQLite.Migrations.M20221029_group_link_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221112_server_password.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221112_server_password.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221112_server_password where
module Simplex.Chat.Store.SQLite.Migrations.M20221112_server_password where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221115_server_cfg.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221115_server_cfg.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221115_server_cfg where
module Simplex.Chat.Store.SQLite.Migrations.M20221115_server_cfg where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221129_delete_group_feature_items.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221129_delete_group_feature_items.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221129_delete_group_feature_items where
module Simplex.Chat.Store.SQLite.Migrations.M20221129_delete_group_feature_items where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221130_delete_item_deleted.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221130_delete_item_deleted.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221130_delete_item_deleted where
module Simplex.Chat.Store.SQLite.Migrations.M20221130_delete_item_deleted where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221209_verified_connection.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221209_verified_connection.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221209_verified_connection where
module Simplex.Chat.Store.SQLite.Migrations.M20221209_verified_connection where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221210_idxs.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221210_idxs.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221210_idxs where
module Simplex.Chat.Store.SQLite.Migrations.M20221210_idxs where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221211_group_description.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221211_group_description.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221211_group_description where
module Simplex.Chat.Store.SQLite.Migrations.M20221211_group_description where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221212_chat_items_timed.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221212_chat_items_timed.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221212_chat_items_timed where
module Simplex.Chat.Store.SQLite.Migrations.M20221212_chat_items_timed where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221214_live_message.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221214_live_message.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221214_live_message where
module Simplex.Chat.Store.SQLite.Migrations.M20221214_live_message where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221222_chat_ts.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221222_chat_ts.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221222_chat_ts where
module Simplex.Chat.Store.SQLite.Migrations.M20221222_chat_ts where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221223_idx_chat_items_item_status.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221223_idx_chat_items_item_status.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221223_idx_chat_items_item_status where
module Simplex.Chat.Store.SQLite.Migrations.M20221223_idx_chat_items_item_status where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20221230_idxs.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20221230_idxs.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221230_idxs where
module Simplex.Chat.Store.SQLite.Migrations.M20221230_idxs where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230107_connections_auth_err_counter.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230107_connections_auth_err_counter.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230107_connections_auth_err_counter where
module Simplex.Chat.Store.SQLite.Migrations.M20230107_connections_auth_err_counter where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230111_users_agent_user_id.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230111_users_agent_user_id.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230111_users_agent_user_id where
module Simplex.Chat.Store.SQLite.Migrations.M20230111_users_agent_user_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230117_fkey_indexes.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230117_fkey_indexes.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230117_fkey_indexes where
module Simplex.Chat.Store.SQLite.Migrations.M20230117_fkey_indexes where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230118_recreate_smp_servers.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230118_recreate_smp_servers.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230118_recreate_smp_servers where
module Simplex.Chat.Store.SQLite.Migrations.M20230118_recreate_smp_servers where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230129_drop_chat_items_group_idx.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230129_drop_chat_items_group_idx.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx where
module Simplex.Chat.Store.SQLite.Migrations.M20230129_drop_chat_items_group_idx where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230206_item_deleted_by_group_member_id.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230206_item_deleted_by_group_member_id.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id where
module Simplex.Chat.Store.SQLite.Migrations.M20230206_item_deleted_by_group_member_id where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230303_group_link_role.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230303_group_link_role.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230303_group_link_role where
module Simplex.Chat.Store.SQLite.Migrations.M20230303_group_link_role where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230317_hidden_profiles.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230317_hidden_profiles.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230317_hidden_profiles where
module Simplex.Chat.Store.SQLite.Migrations.M20230317_hidden_profiles where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230318_file_description.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230318_file_description.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230318_file_description where
module Simplex.Chat.Store.SQLite.Migrations.M20230318_file_description where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230321_agent_file_deleted.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230321_agent_file_deleted where
module Simplex.Chat.Store.SQLite.Migrations.M20230321_agent_file_deleted where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230328_files_protocol.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230328_files_protocol.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230328_files_protocol where
module Simplex.Chat.Store.SQLite.Migrations.M20230328_files_protocol where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230402_protocol_servers.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230402_protocol_servers.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230402_protocol_servers where
module Simplex.Chat.Store.SQLite.Migrations.M20230402_protocol_servers where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230411_extra_xftp_file_descriptions.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230411_extra_xftp_file_descriptions.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230411_extra_xftp_file_descriptions where
module Simplex.Chat.Store.SQLite.Migrations.M20230411_extra_xftp_file_descriptions where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230420_rcv_files_to_receive.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230420_rcv_files_to_receive.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230420_rcv_files_to_receive where
module Simplex.Chat.Store.SQLite.Migrations.M20230420_rcv_files_to_receive where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

2
src/Simplex/Chat/Migrations/M20230422_profile_contact_links.hs → src/Simplex/Chat/Store/SQLite/Migrations/M20230422_profile_contact_links.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230422_profile_contact_links where
module Simplex.Chat.Store.SQLite.Migrations.M20230422_profile_contact_links where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)

Some files were not shown because too many files have changed in this diff Show more