mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: support business addresses and chats (#5272)
* core: support business addresses and chats * types * connect plan, add link type * ios: toggle on address UI * make compile * todo * fix migration * types * comments * fix * remove * fix schema * comment * simplify * remove diff * comment * comment * diff * acceptBusinessJoinRequestAsync wip * comment * update * simplify types * remove business * wip * read/write columns * createBusinessRequestGroup * remove comments * read/write business_address column * validate that business address is not set to be incognito * replace contact card * update simplexmq * refactor * event when accepting business address request * sendGroupAutoReply * delete contact request earlier * test, fix * refactor * refactor2 --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny
GitHub
@@ -56,7 +56,7 @@ initializeBotAddress' logAddress cc = do
|
||||
where
|
||||
showBotAddress uri = do
|
||||
when logAddress $ putStrLn $ "Bot's contact address is: " <> B.unpack (strEncode uri)
|
||||
void $ sendChatCmd cc $ AddressAutoAccept $ Just AutoAccept {acceptIncognito = False, autoReply = Nothing}
|
||||
void $ sendChatCmd cc $ AddressAutoAccept $ Just AutoAccept {businessAddress = False, acceptIncognito = False, autoReply = Nothing}
|
||||
|
||||
sendMessage :: ChatController -> Contact -> Text -> IO ()
|
||||
sendMessage cc ct = sendComposedMessage cc ct Nothing . MCText
|
||||
|
||||
@@ -639,6 +639,7 @@ data ChatResponse
|
||||
| CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest}
|
||||
| CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
|
||||
| CRGroupLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
|
||||
| CRBusinessLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, fromContact :: Contact}
|
||||
| CRUserDeletedMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRGroupsList {user :: User, groups :: [(GroupInfo, GroupSummary)]}
|
||||
| CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
|
||||
@@ -665,6 +666,7 @@ data ChatResponse
|
||||
| CRUserContactLinkDeleted {user :: User}
|
||||
| CRReceivedContactRequest {user :: User, contactRequest :: UserContactRequest}
|
||||
| CRAcceptingContactRequest {user :: User, contact :: Contact}
|
||||
| CRAcceptingBusinessRequest {user :: User, groupInfo :: GroupInfo}
|
||||
| CRContactAlreadyExists {user :: User, contact :: Contact}
|
||||
| CRContactRequestAlreadyAccepted {user :: User, contact :: Contact}
|
||||
| CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
|
||||
|
||||
@@ -0,0 +1,22 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20241128_business_chats where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20241128_business_chats :: Query
|
||||
m20241128_business_chats =
|
||||
[sql|
|
||||
ALTER TABLE user_contact_links ADD business_address INTEGER DEFAULT 0;
|
||||
ALTER TABLE groups ADD COLUMN business_member_id BLOB NULL;
|
||||
ALTER TABLE groups ADD COLUMN business_chat TEXT NULL;
|
||||
|]
|
||||
|
||||
down_m20241128_business_chats :: Query
|
||||
down_m20241128_business_chats =
|
||||
[sql|
|
||||
ALTER TABLE user_contact_links DROP COLUMN business_address;
|
||||
ALTER TABLE groups DROP COLUMN business_member_id;
|
||||
ALTER TABLE groups DROP COLUMN business_chat;
|
||||
|]
|
||||
@@ -127,7 +127,9 @@ CREATE TABLE groups(
|
||||
via_group_link_uri_hash BLOB,
|
||||
user_member_profile_sent_at TEXT,
|
||||
custom_data BLOB,
|
||||
ui_themes TEXT, -- received
|
||||
ui_themes TEXT,
|
||||
business_member_id BLOB NULL,
|
||||
business_chat TEXT NULL, -- received
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
@@ -309,6 +311,7 @@ CREATE TABLE user_contact_links(
|
||||
auto_accept_incognito INTEGER DEFAULT 0 CHECK(auto_accept_incognito NOT NULL),
|
||||
group_link_id BLOB,
|
||||
group_link_member_role TEXT NULL,
|
||||
business_address INTEGER DEFAULT 0,
|
||||
UNIQUE(user_id, local_display_name)
|
||||
);
|
||||
CREATE TABLE contact_requests(
|
||||
|
||||
@@ -66,12 +66,13 @@ import Simplex.Messaging.Version hiding (version)
|
||||
-- 7 - update member profiles (1/15/2024)
|
||||
-- 8 - compress messages and PQ e2e encryption (2024-03-08)
|
||||
-- 9 - batch sending in direct connections (2024-07-24)
|
||||
-- 10 - business chats (2024-11-29)
|
||||
|
||||
-- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
|
||||
-- This indirection is needed for backward/forward compatibility testing.
|
||||
-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
|
||||
currentChatVersion :: VersionChat
|
||||
currentChatVersion = VersionChat 9
|
||||
currentChatVersion = VersionChat 10
|
||||
|
||||
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
|
||||
supportedChatVRange :: VersionRangeChat
|
||||
@@ -110,6 +111,10 @@ pqEncryptionCompressionVersion = VersionChat 8
|
||||
batchSend2Version :: VersionChat
|
||||
batchSend2Version = VersionChat 9
|
||||
|
||||
-- supports differentiating business chats when joining contact addresses
|
||||
businessChatsVersion :: VersionChat
|
||||
businessChatsVersion = VersionChat 10
|
||||
|
||||
agentToChatVersion :: VersionSMPA -> VersionChat
|
||||
agentToChatVersion v
|
||||
| v < pqdrSMPAgentVersion = initialChatVersion
|
||||
|
||||
@@ -123,7 +123,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
-- 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.ui_themes, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_member_id, g.business_chat, 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,
|
||||
|
||||
@@ -30,6 +30,7 @@ module Simplex.Chat.Store.Groups
|
||||
getGroupAndMember,
|
||||
createNewGroup,
|
||||
createGroupInvitation,
|
||||
deleteContactCardKeepConn,
|
||||
createGroupInvitedViaLink,
|
||||
setViaGroupLinkHash,
|
||||
setGroupInvitationChatItemId,
|
||||
@@ -62,6 +63,7 @@ module Simplex.Chat.Store.Groups
|
||||
createNewContactMemberAsync,
|
||||
createAcceptedMember,
|
||||
createAcceptedMemberConnection,
|
||||
createBusinessRequestGroup,
|
||||
getContactViaMember,
|
||||
setNewContactMemberConnRequest,
|
||||
getMemberInvitation,
|
||||
@@ -153,19 +155,20 @@ import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
|
||||
import Simplex.Messaging.Version
|
||||
import UnliftIO.STM
|
||||
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe UIThemeEntityOverrides, Maybe CustomData) :. GroupMemberRow
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe MemberId, Maybe BusinessChatType, Maybe UIThemeEntityOverrides, Maybe CustomData) :. GroupMemberRow
|
||||
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
|
||||
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))
|
||||
|
||||
toGroupInfo :: VersionRangeChat -> Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, uiThemes, customData) :. userMemberRow) =
|
||||
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, businessMemberId, businessChatType, uiThemes, customData) :. userMemberRow) =
|
||||
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
|
||||
fullGroupPreferences = mergeGroupPreferences groupPreferences
|
||||
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, uiThemes, customData}
|
||||
businessChat = BusinessChatInfo <$> businessMemberId <*> businessChatType
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile, businessChat, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, uiThemes, customData}
|
||||
|
||||
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
|
||||
@@ -276,7 +279,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
-- 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.ui_themes, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_member_id, g.business_chat, 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,
|
||||
@@ -342,6 +345,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
|
||||
{ groupId,
|
||||
localDisplayName = ldn,
|
||||
groupProfile,
|
||||
businessChat = Nothing,
|
||||
fullGroupPreferences,
|
||||
membership,
|
||||
hostConnCustomUserProfileId = Nothing,
|
||||
@@ -357,7 +361,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
|
||||
-- | creates a new group record for the group the current user was invited to, or returns an existing one
|
||||
createGroupInvitation :: DB.Connection -> VersionRangeChat -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
|
||||
createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
|
||||
createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId, peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
|
||||
createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId, peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile, businessChat} incognitoProfileId = do
|
||||
liftIO getInvitationGroupId_ >>= \case
|
||||
Nothing -> createGroupInvitation_
|
||||
Just gId -> do
|
||||
@@ -395,10 +399,10 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|
||||
[sql|
|
||||
INSERT INTO groups
|
||||
(group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs,
|
||||
created_at, updated_at, chat_ts, user_member_profile_sent_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?)
|
||||
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_member_id, business_chat)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs)
|
||||
((profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs) :. businessChatTuple businessChat)
|
||||
insertedRowId db
|
||||
let hostVRange = adjustedMemberVRange vr peerChatVRange
|
||||
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
|
||||
@@ -409,6 +413,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|
||||
{ groupId,
|
||||
localDisplayName,
|
||||
groupProfile,
|
||||
businessChat = Nothing,
|
||||
fullGroupPreferences,
|
||||
membership,
|
||||
hostConnCustomUserProfileId = customUserProfileId,
|
||||
@@ -423,6 +428,11 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|
||||
groupMemberId
|
||||
)
|
||||
|
||||
businessChatTuple :: Maybe BusinessChatInfo -> (Maybe MemberId, Maybe BusinessChatType)
|
||||
businessChatTuple = \case
|
||||
Just BusinessChatInfo {memberId, chatType} -> (Just memberId, Just chatType)
|
||||
Nothing -> (Nothing, Nothing)
|
||||
|
||||
adjustedMemberVRange :: VersionRangeChat -> VersionRangeChat -> VersionRangeChat
|
||||
adjustedMemberVRange chatVR vr@(VersionRange minV maxV) =
|
||||
let maxV' = min maxV (maxVersion chatVR)
|
||||
@@ -497,13 +507,19 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
|
||||
)
|
||||
pure $ Right incognitoLdn
|
||||
|
||||
deleteContactCardKeepConn :: DB.Connection -> Int64 -> Contact -> IO ()
|
||||
deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {profileId}} = do
|
||||
DB.execute db "UPDATE connections SET contact_id = NULL WHERE connection_id = ?" (Only connId)
|
||||
DB.execute db "DELETE FROM contacts WHERE contact_id = ?" (Only contactId)
|
||||
DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
|
||||
|
||||
createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createGroupInvitedViaLink
|
||||
db
|
||||
vr
|
||||
user@User {userId, userContactId}
|
||||
Connection {connId, customUserProfileId}
|
||||
GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile} = do
|
||||
GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, businessChat} = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
groupId <- insertGroup_ currentTs
|
||||
hostMemberId <- insertHost_ currentTs groupId
|
||||
@@ -527,10 +543,10 @@ createGroupInvitedViaLink
|
||||
[sql|
|
||||
INSERT INTO groups
|
||||
(group_profile_id, local_display_name, host_conn_custom_user_profile_id, user_id, enable_ntfs,
|
||||
created_at, updated_at, chat_ts, user_member_profile_sent_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?)
|
||||
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_member_id, business_chat)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(profileId, localDisplayName, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs)
|
||||
((profileId, localDisplayName, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs) :. businessChatTuple businessChat)
|
||||
insertedRowId db
|
||||
insertHost_ currentTs groupId = do
|
||||
let fromMemberProfile = profileFromName fromMemberName
|
||||
@@ -637,7 +653,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
|
||||
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.ui_themes, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_member_id, g.business_chat, 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
|
||||
@@ -879,9 +895,7 @@ createAcceptedMember
|
||||
User {userId, userContactId}
|
||||
GroupInfo {groupId, membership}
|
||||
UserContactRequest {cReqChatVRange, localDisplayName, profileId}
|
||||
memberRole = do
|
||||
liftIO $
|
||||
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
memberRole =
|
||||
createWithRandomId gVar $ \memId -> do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
insertMember_ (MemberId memId) createdAt
|
||||
@@ -917,6 +931,46 @@ createAcceptedMemberConnection
|
||||
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV cReqChatVRange Nothing (Just userContactLinkId) Nothing 0 createdAt subMode PQSupportOff
|
||||
setCommandConnId db user cmdId connId
|
||||
|
||||
createBusinessRequestGroup :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> UserContactRequest -> GroupPreferences -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createBusinessRequestGroup
|
||||
db
|
||||
vr
|
||||
gVar
|
||||
user@User {userId}
|
||||
ucr@UserContactRequest {profile}
|
||||
groupPreferences = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
groupInfo <- insertGroup_ currentTs
|
||||
(groupMemberId, memberId) <- createAcceptedMember db gVar user groupInfo ucr GRMember
|
||||
liftIO $ setBusinessMemberId groupInfo memberId
|
||||
acceptedMember <- getGroupMemberById db vr user groupMemberId
|
||||
pure (groupInfo, acceptedMember)
|
||||
where
|
||||
insertGroup_ currentTs = ExceptT $ do
|
||||
let Profile {displayName, fullName, image} = profile
|
||||
withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
|
||||
groupId <- liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO group_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, groupPreferences, currentTs, currentTs)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO groups
|
||||
(group_profile_id, local_display_name, user_id, enable_ntfs,
|
||||
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat)
|
||||
VALUES (?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(profileId, localDisplayName, userId, True, currentTs, currentTs, currentTs, currentTs, BCCustomer)
|
||||
insertedRowId db
|
||||
memberId <- liftIO $ encodedRandomBytes gVar 12
|
||||
void $ createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs vr
|
||||
getGroupInfo db vr user groupId
|
||||
setBusinessMemberId GroupInfo {groupId} businessMemberId = do
|
||||
DB.execute db "UPDATE groups SET business_member_id = ? WHERE group_id = ?" (businessMemberId, groupId)
|
||||
|
||||
getContactViaMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> ExceptT StoreError IO Contact
|
||||
getContactViaMember db vr user@User {userId} GroupMember {groupMemberId} = do
|
||||
contactId <-
|
||||
@@ -1315,7 +1369,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
|
||||
-- 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.ui_themes, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_member_id, g.business_chat, 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,
|
||||
@@ -1411,7 +1465,7 @@ getGroupInfo db vr User {userId, userContactId} groupId =
|
||||
-- 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.ui_themes, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_member_id, g.business_chat, g.ui_themes, g.custom_data,
|
||||
-- GroupMember - 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,
|
||||
|
||||
@@ -117,6 +117,7 @@ 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.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -233,7 +234,8 @@ schemaMigrations =
|
||||
("20241010_contact_requests_contact_id", m20241010_contact_requests_contact_id, Just down_m20241010_contact_requests_contact_id),
|
||||
("20241023_chat_item_autoincrement_id", m20241023_chat_item_autoincrement_id, Just down_m20241023_chat_item_autoincrement_id),
|
||||
("20241027_server_operators", m20241027_server_operators, Just down_m20241027_server_operators),
|
||||
("20241125_indexes", m20241125_indexes, Just down_m20241125_indexes)
|
||||
("20241125_indexes", m20241125_indexes, Just down_m20241125_indexes),
|
||||
("20241128_business_chats", m20241128_business_chats, Just down_m20241128_business_chats)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -445,7 +445,8 @@ data UserContactLink = UserContactLink
|
||||
deriving (Show)
|
||||
|
||||
data AutoAccept = AutoAccept
|
||||
{ acceptIncognito :: IncognitoEnabled,
|
||||
{ businessAddress :: Bool, -- possibly, it can be wrapped together with acceptIncognito, or AutoAccept made sum type
|
||||
acceptIncognito :: IncognitoEnabled,
|
||||
autoReply :: Maybe MsgContent
|
||||
}
|
||||
deriving (Show)
|
||||
@@ -454,10 +455,10 @@ $(J.deriveJSON defaultJSON ''AutoAccept)
|
||||
|
||||
$(J.deriveJSON defaultJSON ''UserContactLink)
|
||||
|
||||
toUserContactLink :: (ConnReqContact, Bool, IncognitoEnabled, Maybe MsgContent) -> UserContactLink
|
||||
toUserContactLink (connReq, autoAccept, acceptIncognito, autoReply) =
|
||||
toUserContactLink :: (ConnReqContact, Bool, Bool, IncognitoEnabled, Maybe MsgContent) -> UserContactLink
|
||||
toUserContactLink (connReq, autoAccept, businessAddress, acceptIncognito, autoReply) =
|
||||
UserContactLink connReq $
|
||||
if autoAccept then Just AutoAccept {acceptIncognito, autoReply} else Nothing
|
||||
if autoAccept then Just AutoAccept {businessAddress, acceptIncognito, autoReply} else Nothing
|
||||
|
||||
getUserAddress :: DB.Connection -> User -> ExceptT StoreError IO UserContactLink
|
||||
getUserAddress db User {userId} =
|
||||
@@ -465,7 +466,7 @@ getUserAddress db User {userId} =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT conn_req_contact, auto_accept, auto_accept_incognito, auto_reply_msg_content
|
||||
SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
|
||||
|]
|
||||
@@ -477,7 +478,7 @@ getUserContactLinkById db userId userContactLinkId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT conn_req_contact, auto_accept, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
|
||||
SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ?
|
||||
AND user_contact_link_id = ?
|
||||
@@ -490,7 +491,7 @@ getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT conn_req_contact, auto_accept, auto_accept_incognito, auto_reply_msg_content
|
||||
SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
|
||||
FROM user_contact_links
|
||||
WHERE user_id = ? AND conn_req_contact IN (?,?)
|
||||
|]
|
||||
@@ -522,13 +523,13 @@ updateUserAddressAutoAccept db user@User {userId} autoAccept = do
|
||||
db
|
||||
[sql|
|
||||
UPDATE user_contact_links
|
||||
SET auto_accept = ?, auto_accept_incognito = ?, auto_reply_msg_content = ?
|
||||
SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ?
|
||||
WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
|
||||
|]
|
||||
(ucl :. Only userId)
|
||||
ucl = case autoAccept of
|
||||
Just AutoAccept {acceptIncognito, autoReply} -> (True, acceptIncognito, autoReply)
|
||||
_ -> (False, False, Nothing)
|
||||
Just AutoAccept {businessAddress, acceptIncognito, autoReply} -> (True, businessAddress, acceptIncognito, autoReply)
|
||||
_ -> (False, False, False, Nothing)
|
||||
|
||||
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> IO [UserServer p]
|
||||
getProtocolServers db p User {userId} =
|
||||
@@ -589,7 +590,7 @@ getServerOperators db = do
|
||||
let conditionsAction = usageConditionsAction ops currentConditions now
|
||||
pure ServerOperatorConditions {serverOperators = ops, currentConditions, conditionsAction}
|
||||
|
||||
getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
|
||||
getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
|
||||
getUserServers db user =
|
||||
(,,)
|
||||
<$> (map Just . serverOperators <$> getServerOperators db)
|
||||
@@ -620,7 +621,8 @@ getUpdateServerOperators db presetOps newUser = do
|
||||
mapM_ insertConditions condsToAdd
|
||||
latestAcceptedConds_ <- getLatestAcceptedConditions db
|
||||
ops <- updatedServerOperators presetOps <$> getServerOperators_ db
|
||||
forM ops $ traverse $ mapM $ \(ASO _ op) -> -- traverse for tuple, mapM for Maybe
|
||||
forM ops $ traverse $ mapM $ \(ASO _ op) ->
|
||||
-- traverse for tuple, mapM for Maybe
|
||||
case operatorId op of
|
||||
DBNewEntity -> do
|
||||
op' <- insertOperator op
|
||||
@@ -765,8 +767,9 @@ acceptConditions db condId opIds acceptedAt = do
|
||||
liftIO $ forM_ operators $ \op -> acceptConditions_ db op conditionsCommit ts
|
||||
where
|
||||
getServerOperator_ opId =
|
||||
ExceptT $ firstRow toServerOperator (SEOperatorNotFound opId) $
|
||||
DB.query db (serverOperatorQuery <> " WHERE server_operator_id = ?") (Only opId)
|
||||
ExceptT $
|
||||
firstRow toServerOperator (SEOperatorNotFound opId) $
|
||||
DB.query db (serverOperatorQuery <> " WHERE server_operator_id = ?") (Only opId)
|
||||
|
||||
acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> Maybe UTCTime -> IO ()
|
||||
acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt =
|
||||
|
||||
@@ -52,7 +52,7 @@ import Simplex.Messaging.Agent.Protocol (ACorrId, AEventTag (..), AEvtTag (..),
|
||||
import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON)
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
|
||||
import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
|
||||
import Simplex.Messaging.Version
|
||||
import Simplex.Messaging.Version.Internal
|
||||
@@ -371,6 +371,7 @@ data GroupInfo = GroupInfo
|
||||
{ groupId :: GroupId,
|
||||
localDisplayName :: GroupName,
|
||||
groupProfile :: GroupProfile,
|
||||
businessChat :: Maybe BusinessChatInfo,
|
||||
fullGroupPreferences :: FullGroupPreferences,
|
||||
membership :: GroupMember,
|
||||
hostConnCustomUserProfileId :: Maybe ProfileId,
|
||||
@@ -384,6 +385,24 @@ data GroupInfo = GroupInfo
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data BusinessChatType
|
||||
= BCBusiness -- used on the customer side
|
||||
| BCCustomer -- used on the business side
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance TextEncoding BusinessChatType where
|
||||
textEncode = \case
|
||||
BCBusiness -> "business"
|
||||
BCCustomer -> "customer"
|
||||
textDecode = \case
|
||||
"business" -> Just BCBusiness
|
||||
"customer" -> Just BCCustomer
|
||||
_ -> Nothing
|
||||
|
||||
instance FromField BusinessChatType where fromField = fromTextField_ textDecode
|
||||
|
||||
instance ToField BusinessChatType where toField = toField . textEncode
|
||||
|
||||
groupName' :: GroupInfo -> GroupName
|
||||
groupName' GroupInfo {localDisplayName = g} = g
|
||||
|
||||
@@ -598,6 +617,7 @@ data GroupInvitation = GroupInvitation
|
||||
invitedMember :: MemberIdRole,
|
||||
connRequest :: ConnReqInvitation,
|
||||
groupProfile :: GroupProfile,
|
||||
businessChat :: Maybe BusinessChatInfo,
|
||||
groupLinkId :: Maybe GroupLinkId,
|
||||
groupSize :: Maybe Int
|
||||
}
|
||||
@@ -608,6 +628,7 @@ data GroupLinkInvitation = GroupLinkInvitation
|
||||
fromMemberName :: ContactName,
|
||||
invitedMember :: MemberIdRole,
|
||||
groupProfile :: GroupProfile,
|
||||
businessChat :: Maybe BusinessChatInfo,
|
||||
groupSize :: Maybe Int
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
@@ -632,6 +653,12 @@ data MemberInfo = MemberInfo
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data BusinessChatInfo = BusinessChatInfo
|
||||
{ memberId :: MemberId,
|
||||
chatType :: BusinessChatType
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
memberInfo :: GroupMember -> MemberInfo
|
||||
memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} =
|
||||
MemberInfo
|
||||
@@ -1696,6 +1723,10 @@ $(JQ.deriveJSON (enumJSON $ dropPrefix "MF") ''MsgFilter)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''ChatSettings)
|
||||
|
||||
$(JQ.deriveJSON (enumJSON $ dropPrefix "BC") ''BusinessChatType)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''BusinessChatInfo)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''GroupInfo)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''Group)
|
||||
@@ -1706,18 +1737,18 @@ instance FromField MsgFilter where fromField = fromIntField_ msgFilterIntP
|
||||
|
||||
instance ToField MsgFilter where toField = toField . msgFilterInt
|
||||
|
||||
$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "CRData") ''CReqClientData)
|
||||
$(JQ.deriveJSON defaultJSON ''CReqClientData)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MemberIdRole)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MemberInfo)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''GroupInvitation)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''GroupLinkInvitation)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''IntroInvitation)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MemberInfo)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MemberRestrictions)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''GroupMemberRef)
|
||||
|
||||
@@ -390,6 +390,33 @@ defaultGroupPrefs =
|
||||
emptyGroupPrefs :: GroupPreferences
|
||||
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
businessGroupPrefs :: Preferences -> GroupPreferences
|
||||
businessGroupPrefs Preferences {timedMessages, fullDelete, reactions, voice} =
|
||||
defaultBusinessGroupPrefs
|
||||
{ timedMessages = Just TimedMessagesGroupPreference {enable = maybe FEOff enableFeature timedMessages, ttl = maybe Nothing prefParam timedMessages},
|
||||
fullDelete = Just FullDeleteGroupPreference {enable = maybe FEOff enableFeature fullDelete},
|
||||
reactions = Just ReactionsGroupPreference {enable = maybe FEOn enableFeature reactions},
|
||||
voice = Just VoiceGroupPreference {enable = maybe FEOff enableFeature voice, role = Nothing}
|
||||
}
|
||||
where
|
||||
enableFeature :: FeatureI f => FeaturePreference f -> GroupFeatureEnabled
|
||||
enableFeature p = case getField @"allow" p of
|
||||
FANo -> FEOff
|
||||
_ -> FEOn
|
||||
|
||||
defaultBusinessGroupPrefs :: GroupPreferences
|
||||
defaultBusinessGroupPrefs =
|
||||
GroupPreferences
|
||||
{ timedMessages = Just $ TimedMessagesGroupPreference FEOff Nothing,
|
||||
directMessages = Just $ DirectMessagesGroupPreference FEOff Nothing,
|
||||
fullDelete = Just $ FullDeleteGroupPreference FEOff,
|
||||
reactions = Just $ ReactionsGroupPreference FEOn,
|
||||
voice = Just $ VoiceGroupPreference FEOff Nothing,
|
||||
files = Just $ FilesGroupPreference FEOn Nothing,
|
||||
simplexLinks = Just $ SimplexLinksGroupPreference FEOn Nothing,
|
||||
history = Just $ HistoryGroupPreference FEOn
|
||||
}
|
||||
|
||||
data TimedMessagesPreference = TimedMessagesPreference
|
||||
{ allow :: FeatureAllowed,
|
||||
ttl :: Maybe Int
|
||||
|
||||
@@ -204,12 +204,14 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
CRContactDeletedByContact u c -> ttyUser u [ttyFullContact c <> " deleted contact with you"]
|
||||
CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo
|
||||
CRAcceptingContactRequest u c -> ttyUser u $ viewAcceptingContactRequest c
|
||||
CRAcceptingBusinessRequest u g -> ttyUser u $ viewAcceptingBusinessRequest g
|
||||
CRContactAlreadyExists u c -> ttyUser u [ttyFullContact c <> ": contact already exists"]
|
||||
CRContactRequestAlreadyAccepted u c -> ttyUser u [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
|
||||
CRUserContactLinkCreated u cReq -> ttyUser u $ connReqContact_ "Your new chat address is created!" cReq
|
||||
CRUserContactLinkDeleted u -> ttyUser u viewUserContactLinkDeleted
|
||||
CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
|
||||
CRGroupLinkConnecting u g _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
|
||||
CRBusinessLinkConnecting u g _ _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
|
||||
CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRUnknownMemberCreated u g fwdM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember fwdM <> " forwarded a message from an unknown member, creating unknown member record " <> ttyMember um]
|
||||
@@ -979,9 +981,14 @@ simplexChatContact (CRContactUri crData) = CRContactUri crData {crScheme = simpl
|
||||
|
||||
autoAcceptStatus_ :: Maybe AutoAccept -> [StyledString]
|
||||
autoAcceptStatus_ = \case
|
||||
Just AutoAccept {acceptIncognito, autoReply} ->
|
||||
("auto_accept on" <> if acceptIncognito then ", incognito" else "")
|
||||
Just AutoAccept {businessAddress, acceptIncognito, autoReply} ->
|
||||
("auto_accept on" <> aaInfo)
|
||||
: maybe [] ((["auto reply:"] <>) . ttyMsgContent) autoReply
|
||||
where
|
||||
aaInfo
|
||||
| businessAddress = ", business"
|
||||
| acceptIncognito = ", incognito"
|
||||
| otherwise = ""
|
||||
_ -> ["auto_accept off"]
|
||||
|
||||
groupLink_ :: StyledString -> GroupInfo -> ConnReqContact -> GroupMemberRole -> [StyledString]
|
||||
@@ -1017,6 +1024,9 @@ viewAcceptingContactRequest ct
|
||||
| contactReady ct = [ttyFullContact ct <> ": accepting contact request, you can send messages to contact"]
|
||||
| otherwise = [ttyFullContact ct <> ": accepting contact request..."]
|
||||
|
||||
viewAcceptingBusinessRequest :: GroupInfo -> [StyledString]
|
||||
viewAcceptingBusinessRequest g = [ttyFullGroup g <> ": accepting business address request..."]
|
||||
|
||||
viewReceivedContactRequest :: ContactName -> Profile -> [StyledString]
|
||||
viewReceivedContactRequest c Profile {fullName} =
|
||||
[ ttyFullName c fullName <> " wants to connect to you!",
|
||||
|
||||
Reference in New Issue
Block a user