IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: full/merged preferences in User, Contact, GroupInfo types (#1365)

Browse Source 
* core: preferences in User, Contact, GroupInfo types

* user and group preferences

* refactor

* linebreak

* remove synonyms

* refactor

* refactor

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
JRoberts 2022-11-15 10:31:44 +04:00 committed by GitHub
parent 40e1b01baf
commit b5a812769b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 237 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
src/Simplex/Chat.hs
View File

@ -279,7 +279,7 @@ processChatCommand = \case
APIGetChatItems _pagination -> pure $ chatCmdError "not implemented" APIGetChatItems _pagination -> pure $ chatCmdError "not implemented"
APISendMessage (ChatRef cType chatId) (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of APISendMessage (ChatRef cType chatId) (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
CTDirect -> do CTDirect -> do
ct@Contact {localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db userId chatId ct@Contact {localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
(fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct (fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_ (msgContainer, quotedItem_) <- prepareMsg fileInvitation_
@ -396,7 +396,7 @@ processChatCommand = \case
unzipMaybe3 _ = (Nothing, Nothing, Nothing) unzipMaybe3 _ = (Nothing, Nothing, Nothing)
APIUpdateChatItem (ChatRef cType chatId) itemId mc -> withUser $ \user@User {userId} -> withChatLock "updateChatItem" $ case cType of APIUpdateChatItem (ChatRef cType chatId) itemId mc -> withUser $ \user@User {userId} -> withChatLock "updateChatItem" $ case cType of
CTDirect -> do CTDirect -> do
(ct@Contact {contactId, localDisplayName = c}, ci) <- withStore $ \db -> (,) <$> getContact db userId chatId <*> getDirectChatItem db userId chatId itemId (ct@Contact {contactId, localDisplayName = c}, ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
case ci of case ci of
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId}, content = ciContent} -> do CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId}, content = ciContent} -> do
case (ciContent, itemSharedMsgId) of case (ciContent, itemSharedMsgId) of
@ -425,7 +425,7 @@ processChatCommand = \case
CTContactConnection -> pure $ chatCmdError "not supported" CTContactConnection -> pure $ chatCmdError "not supported"
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user@User {userId} -> withChatLock "deleteChatItem" $ case cType of APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user@User {userId} -> withChatLock "deleteChatItem" $ case cType of
CTDirect -> do CTDirect -> do
(ct@Contact {localDisplayName = c}, CChatItem msgDir deletedItem@ChatItem {meta = CIMeta {itemSharedMsgId}, file}) <- withStore $ \db -> (,) <$> getContact db userId chatId <*> getDirectChatItem db userId chatId itemId (ct@Contact {localDisplayName = c}, CChatItem msgDir deletedItem@ChatItem {meta = CIMeta {itemSharedMsgId}, file}) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
case (mode, msgDir, itemSharedMsgId) of case (mode, msgDir, itemSharedMsgId) of
(CIDMInternal, _, _) -> do (CIDMInternal, _, _) -> do
deleteCIFile user file deleteCIFile user file
@ -468,10 +468,10 @@ processChatCommand = \case
CTGroup -> withStore' (\db -> updateGroupChatItemsRead db chatId fromToIds) $> CRCmdOk CTGroup -> withStore' (\db -> updateGroupChatItemsRead db chatId fromToIds) $> CRCmdOk
CTContactRequest -> pure $ chatCmdError "not supported" CTContactRequest -> pure $ chatCmdError "not supported"
CTContactConnection -> pure $ chatCmdError "not supported" CTContactConnection -> pure $ chatCmdError "not supported"
APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user@User {userId} -> case cType of APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user -> case cType of
CTDirect -> do CTDirect -> do
withStore $ \db -> do withStore $ \db -> do
ct <- getContact db userId chatId ct <- getContact db user chatId
liftIO $ updateContactUnreadChat db user ct unreadChat liftIO $ updateContactUnreadChat db user ct unreadChat
pure CRCmdOk pure CRCmdOk
CTGroup -> do CTGroup -> do
@ -482,7 +482,7 @@ processChatCommand = \case
_ -> pure $ chatCmdError "not supported" _ -> pure $ chatCmdError "not supported"
APIDeleteChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of APIDeleteChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of
CTDirect -> do CTDirect -> do
ct@Contact {localDisplayName} <- withStore $ \db -> getContact db userId chatId ct@Contact {localDisplayName} <- withStore $ \db -> getContact db user chatId
filesInfo <- withStore' $ \db -> getContactFileInfo db user ct filesInfo <- withStore' $ \db -> getContactFileInfo db user ct
conns <- withStore $ \db -> getContactConnections db userId ct conns <- withStore $ \db -> getContactConnections db userId ct
withChatLock "deleteChat direct" . procCmd $ do withChatLock "deleteChat direct" . procCmd $ do
@ -516,9 +516,9 @@ processChatCommand = \case
withStore' $ \db -> deleteGroup db user gInfo withStore' $ \db -> deleteGroup db user gInfo
pure $ CRGroupDeletedUser gInfo pure $ CRGroupDeletedUser gInfo
CTContactRequest -> pure $ chatCmdError "not supported" CTContactRequest -> pure $ chatCmdError "not supported"
APIClearChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of APIClearChat (ChatRef cType chatId) -> withUser $ \user -> case cType of
CTDirect -> do CTDirect -> do
ct <- withStore $ \db -> getContact db userId chatId ct <- withStore $ \db -> getContact db user chatId
filesInfo <- withStore' $ \db -> getContactFileInfo db user ct filesInfo <- withStore' $ \db -> getContactFileInfo db user ct
maxItemTs_ <- withStore' $ \db -> getContactMaxItemTs db user ct maxItemTs_ <- withStore' $ \db -> getContactMaxItemTs db user ct
forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo
@ -561,7 +561,7 @@ processChatCommand = \case
pure $ CRContactRequestRejected cReq pure $ CRContactRequestRejected cReq
APISendCallInvitation contactId callType -> withUser $ \user@User {userId} -> do APISendCallInvitation contactId callType -> withUser $ \user@User {userId} -> do
-- party initiating call -- party initiating call
ct <- withStore $ \db -> getContact db userId contactId ct <- withStore $ \db -> getContact db user contactId
calls <- asks currentCalls calls <- asks currentCalls
withChatLock "sendCallInvitation" $ do withChatLock "sendCallInvitation" $ do
callId <- CallId <$> (asks idsDrg >>= liftIO . (`randomBytes` 16)) callId <- CallId <$> (asks idsDrg >>= liftIO . (`randomBytes` 16))
@ -629,27 +629,27 @@ processChatCommand = \case
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallEnd callId) (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallEnd callId)
updateCallItemStatus userId ct call WCSDisconnected $ Just msgId updateCallItemStatus userId ct call WCSDisconnected $ Just msgId
pure Nothing pure Nothing
APIGetCallInvitations -> withUser $ \User {userId} -> do APIGetCallInvitations -> withUser $ \user -> do
calls <- asks currentCalls >>= readTVarIO calls <- asks currentCalls >>= readTVarIO
let invs = mapMaybe callInvitation $ M.elems calls let invs = mapMaybe callInvitation $ M.elems calls
CRCallInvitations <$> mapM (rcvCallInvitation userId) invs CRCallInvitations <$> mapM (rcvCallInvitation user) invs
where where
callInvitation Call {contactId, callState, callTs} = case callState of callInvitation Call {contactId, callState, callTs} = case callState of
CallInvitationReceived {peerCallType, sharedKey} -> Just (contactId, callTs, peerCallType, sharedKey) CallInvitationReceived {peerCallType, sharedKey} -> Just (contactId, callTs, peerCallType, sharedKey)
_ -> Nothing _ -> Nothing
rcvCallInvitation userId (contactId, callTs, peerCallType, sharedKey) = do rcvCallInvitation user (contactId, callTs, peerCallType, sharedKey) = do
contact <- withStore (\db -> getContact db userId contactId) contact <- withStore (\db -> getContact db user contactId)
pure RcvCallInvitation {contact, callType = peerCallType, sharedKey, callTs} pure RcvCallInvitation {contact, callType = peerCallType, sharedKey, callTs}
APICallStatus contactId receivedStatus -> APICallStatus contactId receivedStatus ->
withCurrentCall contactId $ \userId ct call -> withCurrentCall contactId $ \userId ct call ->
updateCallItemStatus userId ct call receivedStatus Nothing $> Just call updateCallItemStatus userId ct call receivedStatus Nothing $> Just call
APIUpdateProfile profile -> withUser (`updateProfile` profile) APIUpdateProfile profile -> withUser (`updateProfile` profile)
APISetContactPrefs contactId prefs' -> withUser $ \user@User {userId} -> do APISetContactPrefs contactId prefs' -> withUser $ \user -> do
ct <- withStore $ \db -> getContact db userId contactId ct <- withStore $ \db -> getContact db user contactId
updateContactPrefs user ct prefs' updateContactPrefs user ct prefs'
APISetContactAlias contactId localAlias -> withUser $ \User {userId} -> do APISetContactAlias contactId localAlias -> withUser $ \user@User {userId} -> do
ct' <- withStore $ \db -> do ct' <- withStore $ \db -> do
ct <- getContact db userId contactId ct <- getContact db user contactId
liftIO $ updateContactAlias db userId ct localAlias liftIO $ updateContactAlias db userId ct localAlias
pure $ CRContactAliasUpdated ct' pure $ CRContactAliasUpdated ct'
APISetConnectionAlias connId localAlias -> withUser $ \User {userId} -> do APISetConnectionAlias connId localAlias -> withUser $ \User {userId} -> do
@ -692,10 +692,10 @@ processChatCommand = \case
APIGetChatItemTTL -> CRChatItemTTL <$> withUser (\user -> withStore' (`getChatItemTTL` user)) APIGetChatItemTTL -> CRChatItemTTL <$> withUser (\user -> withStore' (`getChatItemTTL` user))
APISetNetworkConfig cfg -> withUser' $ \_ -> withAgent (`setNetworkConfig` cfg) $> CRCmdOk APISetNetworkConfig cfg -> withUser' $ \_ -> withAgent (`setNetworkConfig` cfg) $> CRCmdOk
APIGetNetworkConfig -> CRNetworkConfig <$> withUser' (\_ -> withAgent getNetworkConfig) APIGetNetworkConfig -> CRNetworkConfig <$> withUser' (\_ -> withAgent getNetworkConfig)
APISetChatSettings (ChatRef cType chatId) chatSettings -> withUser $ \user@User {userId} -> case cType of APISetChatSettings (ChatRef cType chatId) chatSettings -> withUser $ \user -> case cType of
CTDirect -> do CTDirect -> do
ct <- withStore $ \db -> do ct <- withStore $ \db -> do
ct <- getContact db userId chatId ct <- getContact db user chatId
liftIO $ updateContactSettings db user chatId chatSettings liftIO $ updateContactSettings db user chatId chatSettings
pure ct pure ct
withAgent $ \a -> toggleConnectionNtfs a (contactConnId ct) (enableNtfs chatSettings) withAgent $ \a -> toggleConnectionNtfs a (contactConnId ct) (enableNtfs chatSettings)
@ -709,9 +709,9 @@ processChatCommand = \case
withAgent (\a -> toggleConnectionNtfs a connId $ enableNtfs chatSettings) `catchError` (toView . CRChatError) withAgent (\a -> toggleConnectionNtfs a connId $ enableNtfs chatSettings) `catchError` (toView . CRChatError)
pure CRCmdOk pure CRCmdOk
_ -> pure $ chatCmdError "not supported" _ -> pure $ chatCmdError "not supported"
APIContactInfo contactId -> withUser $ \User {userId} -> do APIContactInfo contactId -> withUser $ \user@User {userId} -> do
-- [incognito] print user's incognito profile for this contact -- [incognito] print user's incognito profile for this contact
ct@Contact {activeConn = Connection {customUserProfileId}} <- withStore $ \db -> getContact db userId contactId ct@Contact {activeConn = Connection {customUserProfileId}} <- withStore $ \db -> getContact db user contactId
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
connectionStats <- withAgent (`getConnectionServers` contactConnId ct) connectionStats <- withAgent (`getConnectionServers` contactConnId ct)
pure $ CRContactInfo ct connectionStats (fmap fromLocalProfile incognitoProfile) pure $ CRContactInfo ct connectionStats (fmap fromLocalProfile incognitoProfile)
@ -719,8 +719,8 @@ processChatCommand = \case
(g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m) connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m)
pure $ CRGroupMemberInfo g m connectionStats pure $ CRGroupMemberInfo g m connectionStats
APISwitchContact contactId -> withUser $ \User {userId} -> do APISwitchContact contactId -> withUser $ \user -> do
ct <- withStore $ \db -> getContact db userId contactId ct <- withStore $ \db -> getContact db user contactId
withAgent $ \a -> switchConnectionAsync a "" $ contactConnId ct withAgent $ \a -> switchConnectionAsync a "" $ contactConnId ct
pure CRCmdOk pure CRCmdOk
APISwitchGroupMember gId gMemberId -> withUser $ \user -> do APISwitchGroupMember gId gMemberId -> withUser $ \user -> do
@ -837,9 +837,9 @@ processChatCommand = \case
gVar <- asks idsDrg gVar <- asks idsDrg
groupInfo <- withStore (\db -> createNewGroup db gVar user gProfile) groupInfo <- withStore (\db -> createNewGroup db gVar user gProfile)
pure $ CRGroupCreated groupInfo pure $ CRGroupCreated groupInfo
APIAddMember groupId contactId memRole -> withUser $ \user@User {userId} -> withChatLock "addMember" $ do APIAddMember groupId contactId memRole -> withUser $ \user -> withChatLock "addMember" $ do
-- TODO for large groups: no need to load all members to determine if contact is a member -- TODO for large groups: no need to load all members to determine if contact is a member
(group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db userId contactId (group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db user contactId
let Group gInfo@GroupInfo {membership} members = group let Group gInfo@GroupInfo {membership} members = group
GroupMember {memberRole = userRole} = membership GroupMember {memberRole = userRole} = membership
Contact {localDisplayName = cName} = contact Contact {localDisplayName = cName} = contact
@ -891,7 +891,7 @@ processChatCommand = \case
Just m -> changeMemberRole user gInfo members m $ SGEMemberRole memberId (fromLocalProfile $ memberProfile m) memRole Just m -> changeMemberRole user gInfo members m $ SGEMemberRole memberId (fromLocalProfile $ memberProfile m) memRole
_ -> throwChatError CEGroupMemberNotFound _ -> throwChatError CEGroupMemberNotFound
where where
changeMemberRole user@User {userId} gInfo@GroupInfo {membership} members m gEvent = do changeMemberRole user gInfo@GroupInfo {membership} members m gEvent = do
let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m
GroupMember {memberRole = userRole} = membership GroupMember {memberRole = userRole} = membership
canChangeRole = userRole >= GRAdmin && userRole >= mRole && userRole >= memRole && memberCurrent membership canChangeRole = userRole >= GRAdmin && userRole >= mRole && userRole >= memRole && memberCurrent membership
@ -901,7 +901,7 @@ processChatCommand = \case
withStore' $ \db -> updateGroupMemberRole db user m memRole withStore' $ \db -> updateGroupMemberRole db user m memRole
case mStatus of case mStatus of
GSMemInvited -> do GSMemInvited -> do
withStore (\db -> (,) <$> mapM (getContact db userId) memberContactId <*> liftIO (getMemberInvitation db user $ groupMemberId' m)) >>= \case withStore (\db -> (,) <$> mapM (getContact db user) memberContactId <*> liftIO (getMemberInvitation db user $ groupMemberId' m)) >>= \case
(Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq (Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName _ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
_ -> do _ -> do
@ -1051,7 +1051,7 @@ processChatCommand = \case
sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId
withStore (\db -> getChatRefByFileId db user fileId) >>= \case withStore (\db -> getChatRefByFileId db user fileId) >>= \case
ChatRef CTDirect contactId -> do ChatRef CTDirect contactId -> do
contact <- withStore $ \db -> getContact db userId contactId contact <- withStore $ \db -> getContact db user contactId
void . sendDirectContactMessage contact $ XFileCancel sharedMsgId void . sendDirectContactMessage contact $ XFileCancel sharedMsgId
ChatRef CTGroup groupId -> do ChatRef CTGroup groupId -> do
Group gInfo ms <- withStore $ \db -> getGroup db user groupId Group gInfo ms <- withStore $ \db -> getGroup db user groupId
@ -1114,7 +1114,7 @@ processChatCommand = \case
connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse
connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
withStore' (\db -> getConnReqContactXContactId db userId cReqHash) >>= \case withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case
(Just contact, _) -> pure $ CRContactAlreadyExists contact (Just contact, _) -> pure $ CRContactAlreadyExists contact
(_, xContactId_) -> procCmd $ do (_, xContactId_) -> procCmd $ do
let randomXContactId = XContactId <$> (asks idsDrg >>= liftIO . (`randomBytes` 16)) let randomXContactId = XContactId <$> (asks idsDrg >>= liftIO . (`randomBytes` 16))
@ -1165,25 +1165,22 @@ processChatCommand = \case
void (sendDirectContactMessage ct $ XInfo mergedProfile) `catchError` (toView . CRChatError) void (sendDirectContactMessage ct $ XInfo mergedProfile) `catchError` (toView . CRChatError)
pure $ CRUserProfileUpdated (fromLocalProfile p) p' pure $ CRUserProfileUpdated (fromLocalProfile p) p'
updateContactPrefs :: User -> Contact -> Preferences -> m ChatResponse updateContactPrefs :: User -> Contact -> Preferences -> m ChatResponse
updateContactPrefs user@User {userId} ct@Contact {contactId, activeConn = Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' updateContactPrefs user@User {userId} ct@Contact {activeConn = Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs'
| contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated ct ct $ contactUserPreferences user ct -- nothing changed actually | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated ct ct
| otherwise = do | otherwise = do
withStore' $ \db -> updateContactUserPreferences db userId contactId contactUserPrefs' ct' <- withStore' $ \db -> updateContactUserPreferences db user ct contactUserPrefs'
-- [incognito] filter out contacts with whom user has incognito connections
let ct' = (ct :: Contact) {userPreferences = contactUserPrefs'}
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
let p' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') let p' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct')
withChatLock "updateProfile" . procCmd $ do withChatLock "updateProfile" . procCmd $ do
void (sendDirectContactMessage ct' $ XInfo p') `catchError` (toView . CRChatError) void (sendDirectContactMessage ct' $ XInfo p') `catchError` (toView . CRChatError)
pure $ CRContactPrefsUpdated ct ct' $ contactUserPreferences user ct' pure $ CRContactPrefsUpdated ct ct'
isReady :: Contact -> Bool isReady :: Contact -> Bool
isReady ct = isReady ct =
let s = connStatus $ activeConn (ct :: Contact) let s = connStatus $ activeConn (ct :: Contact)
in s == ConnReady || s == ConnSndReady in s == ConnReady || s == ConnSndReady
withCurrentCall :: ContactId -> (UserId -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse withCurrentCall :: ContactId -> (UserId -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse
withCurrentCall ctId action = withUser $ \user@User {userId} -> do withCurrentCall ctId action = withUser $ \user@User {userId} -> do
ct <- withStore $ \db -> getContact db userId ctId ct <- withStore $ \db -> getContact db user ctId
calls <- asks currentCalls calls <- asks currentCalls
withChatLock "currentCall" $ withChatLock "currentCall" $
atomically (TM.lookup ctId calls) >>= \case atomically (TM.lookup ctId calls) >>= \case
@ -1313,7 +1310,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F
chatRef <- withStore $ \db -> getChatRefByFileId db user fileId chatRef <- withStore $ \db -> getChatRefByFileId db user fileId
case (chatRef, grpMemberId) of case (chatRef, grpMemberId) of
(ChatRef CTDirect contactId, Nothing) -> do (ChatRef CTDirect contactId, Nothing) -> do
ct <- withStore $ \db -> getContact db userId contactId ct <- withStore $ \db -> getContact db user contactId
(msg, ci) <- acceptFile (msg, ci) <- acceptFile
void $ sendDirectContactMessage ct msg void $ sendDirectContactMessage ct msg
pure ci pure ci
@ -2057,7 +2054,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
where where
profileContactRequest :: InvitationId -> Profile -> Maybe XContactId -> m () profileContactRequest :: InvitationId -> Profile -> Maybe XContactId -> m ()
profileContactRequest invId p xContactId_ = do profileContactRequest invId p xContactId_ = do
withStore (\db -> createOrUpdateContactRequest db userId userContactLinkId invId p xContactId_) >>= \case withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId p xContactId_) >>= \case
CORContact contact -> toView $ CRContactRequestAlreadyAccepted contact CORContact contact -> toView $ CRContactRequestAlreadyAccepted contact
CORRequest cReq@UserContactRequest {localDisplayName} -> do CORRequest cReq@UserContactRequest {localDisplayName} -> do
withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
@ -2151,7 +2148,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
if connectedIncognito if connectedIncognito
then withStore' $ \db -> deleteSentProbe db userId probeId then withStore' $ \db -> deleteSentProbe db userId probeId
else do else do
cs <- withStore' $ \db -> getMatchingContacts db userId ct cs <- withStore' $ \db -> getMatchingContacts db user ct
let probeHash = ProbeHash $ C.sha256Hash (unProbe probe) let probeHash = ProbeHash $ C.sha256Hash (unProbe probe)
forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchError` const (pure ()) forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchError` const (pure ())
where where
@ -2466,21 +2463,21 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
xInfo :: Contact -> Profile -> m () xInfo :: Contact -> Profile -> m ()
xInfo c@Contact {profile = p} p' = unless (fromLocalProfile p == p') $ do xInfo c@Contact {profile = p} p' = unless (fromLocalProfile p == p') $ do
c' <- withStore $ \db -> updateContactProfile db userId c p' c' <- withStore $ \db -> updateContactProfile db user c p'
toView $ CRContactUpdated c c' $ contactUserPreferences user c' toView $ CRContactUpdated c c'
xInfoProbe :: Contact -> Probe -> m () xInfoProbe :: Contact -> Probe -> m ()
xInfoProbe c2 probe = xInfoProbe c2 probe =
-- [incognito] unless connected incognito -- [incognito] unless connected incognito
unless (contactConnIncognito c2) $ do unless (contactConnIncognito c2) $ do
r <- withStore' $ \db -> matchReceivedProbe db userId c2 probe r <- withStore' $ \db -> matchReceivedProbe db user c2 probe
forM_ r $ \c1 -> probeMatch c1 c2 probe forM_ r $ \c1 -> probeMatch c1 c2 probe
xInfoProbeCheck :: Contact -> ProbeHash -> m () xInfoProbeCheck :: Contact -> ProbeHash -> m ()
xInfoProbeCheck c1 probeHash = xInfoProbeCheck c1 probeHash =
-- [incognito] unless connected incognito -- [incognito] unless connected incognito
unless (contactConnIncognito c1) $ do unless (contactConnIncognito c1) $ do
r <- withStore' $ \db -> matchReceivedProbeHash db userId c1 probeHash r <- withStore' $ \db -> matchReceivedProbeHash db user c1 probeHash
forM_ r . uncurry $ probeMatch c1 forM_ r . uncurry $ probeMatch c1
probeMatch :: Contact -> Contact -> Probe -> m () probeMatch :: Contact -> Contact -> Probe -> m ()
@ -2493,7 +2490,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
xInfoProbeOk :: Contact -> Probe -> m () xInfoProbeOk :: Contact -> Probe -> m ()
xInfoProbeOk c1@Contact {contactId = cId1} probe = do xInfoProbeOk c1@Contact {contactId = cId1} probe = do
r <- withStore' $ \db -> matchSentProbe db userId c1 probe r <- withStore' $ \db -> matchSentProbe db user c1 probe
forM_ r $ \c2@Contact {contactId = cId2} -> forM_ r $ \c2@Contact {contactId = cId2} ->
if cId1 /= cId2 if cId1 /= cId2
then mergeContacts c1 c2 then mergeContacts c1 c2
@ -2608,7 +2605,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
ChatMessage {chatMsgEvent} <- parseChatMessage connInfo ChatMessage {chatMsgEvent} <- parseChatMessage connInfo
case chatMsgEvent of case chatMsgEvent of
XInfo p -> do XInfo p -> do
ct <- withStore $ \db -> createDirectContact db userId activeConn p ct <- withStore $ \db -> createDirectContact db user activeConn p
toView $ CRContactConnecting ct toView $ CRContactConnecting ct
-- TODO show/log error, other events in SMP confirmation -- TODO show/log error, other events in SMP confirmation
_ -> pure () _ -> pure ()

4
src/Simplex/Chat/Controller.hs
View File

@ -296,7 +296,7 @@ data ChatResponse
| CRInvitation {connReqInvitation :: ConnReqInvitation} | CRInvitation {connReqInvitation :: ConnReqInvitation}
| CRSentConfirmation | CRSentConfirmation
| CRSentInvitation {customUserProfile :: Maybe Profile} | CRSentInvitation {customUserProfile :: Maybe Profile}
| CRContactUpdated {fromContact :: Contact, toContact :: Contact, preferences :: ContactUserPreferences} | CRContactUpdated {fromContact :: Contact, toContact :: Contact}
| CRContactsMerged {intoContact :: Contact, mergedContact :: Contact} | CRContactsMerged {intoContact :: Contact, mergedContact :: Contact}
| CRContactDeleted {contact :: Contact} | CRContactDeleted {contact :: Contact}
| CRChatCleared {chatInfo :: AChatInfo} | CRChatCleared {chatInfo :: AChatInfo}
@ -322,7 +322,7 @@ data ChatResponse
| CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile} | CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile}
| CRContactAliasUpdated {toContact :: Contact} | CRContactAliasUpdated {toContact :: Contact}
| CRConnectionAliasUpdated {toConnection :: PendingContactConnection} | CRConnectionAliasUpdated {toConnection :: PendingContactConnection}
| CRContactPrefsUpdated {fromContact :: Contact, toContact :: Contact, preferences :: ContactUserPreferences} | CRContactPrefsUpdated {fromContact :: Contact, toContact :: Contact}
| CRContactConnecting {contact :: Contact} | CRContactConnecting {contact :: Contact}
| CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile} | CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile}
| CRContactAnotherClient {contact :: Contact} | CRContactAnotherClient {contact :: Contact}

151
src/Simplex/Chat/Store.hs
View File

@ -414,7 +414,7 @@ getUsers db =
toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe Preferences) -> User toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe Preferences) -> User
toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) = toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) =
let profile = LocalProfile {profileId, displayName, fullName, image, preferences = userPreferences, localAlias = ""} let profile = LocalProfile {profileId, displayName, fullName, image, preferences = userPreferences, localAlias = ""}
in User {userId, userContactId, localDisplayName = displayName, profile, activeUser} in User {userId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences = mergePreferences Nothing userPreferences}
setActiveUser :: DB.Connection -> UserId -> IO () setActiveUser :: DB.Connection -> UserId -> IO ()
setActiveUser db userId = do setActiveUser db userId = do
@ -438,15 +438,15 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
pccConnId <- insertedRowId db pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt} pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
getConnReqContactXContactId :: DB.Connection -> UserId -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId) getConnReqContactXContactId :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
getConnReqContactXContactId db userId cReqHash = do getConnReqContactXContactId db user@User {userId} cReqHash = do
getContact' >>= \case getContact' >>= \case
c@(Just _) -> pure (c, Nothing) c@(Just _) -> pure (c, Nothing)
Nothing -> (Nothing,) <$> getXContactId Nothing -> (Nothing,) <$> getXContactId
where where
getContact' :: IO (Maybe Contact) getContact' :: IO (Maybe Contact)
getContact' = getContact' =
maybeFirstRow toContact $ maybeFirstRow (toContact user) $
DB.query DB.query
db db
[sql| [sql|
@ -534,11 +534,14 @@ createConnection_ db userId connType entityId acId viaContact viaUserContactLink
where where
ent ct = if connType == ct then entityId else Nothing ent ct = if connType == ct then entityId else Nothing
createDirectContact :: DB.Connection -> UserId -> Connection -> Profile -> ExceptT StoreError IO Contact createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
createDirectContact db userId activeConn@Connection {connId, localAlias} profile = do createDirectContact db user@User {userId} activeConn@Connection {connId, localAlias} p@Profile {preferences} = do
createdAt <- liftIO getCurrentTime createdAt <- liftIO getCurrentTime
(localDisplayName, contactId, profileId) <- createContact_ db userId connId profile localAlias Nothing createdAt (localDisplayName, contactId, profileId) <- createContact_ db userId connId p localAlias Nothing createdAt
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile localAlias, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences = emptyChatPrefs, createdAt, updatedAt = createdAt} let profile = toLocalProfile profileId p localAlias
userPreferences = emptyChatPrefs
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt}
createContact_ :: DB.Connection -> UserId -> Int64 -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId) createContact_ :: DB.Connection -> UserId -> Int64 -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
createContact_ db userId connId Profile {displayName, fullName, image, preferences} localAlias viaGroup currentTs = createContact_ db userId connId Profile {displayName, fullName, image, preferences} localAlias viaGroup currentTs =
@ -632,24 +635,32 @@ updateUserProfile db User {userId, userContactId, localDisplayName, profile = Lo
updateContactProfile_' db userId profileId p' currentTs updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId userContactId localDisplayName newName currentTs updateContact_ db userId userContactId localDisplayName newName currentTs
updateContactProfile :: DB.Connection -> UserId -> Contact -> Profile -> ExceptT StoreError IO Contact updateContactProfile :: DB.Connection -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile db userId c@Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}} p'@Profile {displayName = newName} updateContactProfile db user@User {userId} c p'
| displayName == newName = | displayName == newName = do
liftIO $ updateContactProfile_ db userId profileId p' $> (c :: Contact) {profile = toLocalProfile profileId p' localAlias} liftIO $ updateContactProfile_ db userId profileId p'
pure $ c {profile, mergedPreferences}
| otherwise = | otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId contactId localDisplayName ldn currentTs updateContact_ db userId contactId localDisplayName ldn currentTs
pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias} pure . Right $ c {localDisplayName = ldn, profile, mergedPreferences}
where
Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, activeConn, userPreferences} = c
Profile {displayName = newName, preferences} = p'
profile = toLocalProfile profileId p' localAlias
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
updateContactUserPreferences :: DB.Connection -> UserId -> Int64 -> Preferences -> IO () updateContactUserPreferences :: DB.Connection -> User -> Contact -> Preferences -> IO Contact
updateContactUserPreferences db userId contactId userPreferences = do updateContactUserPreferences db user@User {userId} c@Contact {contactId, activeConn} userPreferences = do
updatedAt <- getCurrentTime updatedAt <- getCurrentTime
DB.execute DB.execute
db db
"UPDATE contacts SET user_preferences = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" "UPDATE contacts SET user_preferences = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
(userPreferences, updatedAt, userId, contactId) (userPreferences, updatedAt, userId, contactId)
let mergedPreferences = contactUserPreferences user userPreferences (preferences' c) $ connIncognito activeConn
pure $ c {mergedPreferences, userPreferences}
updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do
@ -722,33 +733,35 @@ updateContact_ db userId contactId displayName newName updatedAt = do
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, LocalAlias, Bool, Maybe Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime) type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, LocalAlias, Bool, Maybe Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime)
toContact :: ContactRow :. ConnectionRow -> Contact toContact :: User -> ContactRow :. ConnectionRow -> Contact
toContact (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) = toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias} let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
activeConn = toConnection connRow activeConn = toConnection connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, createdAt, updatedAt} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt}
toContactOrError :: ContactRow :. MaybeConnectionRow -> Either StoreError Contact toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact
toContactOrError (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) = toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias} let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in case toMaybeConnection connRow of in case toMaybeConnection connRow of
Just activeConn -> Just activeConn ->
Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, createdAt, updatedAt} let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt}
_ -> Left $ SEContactNotReady localDisplayName _ -> Left $ SEContactNotReady localDisplayName
-- TODO return the last connection that is ready, not any last connection -- TODO return the last connection that is ready, not any last connection
-- requires updating connection status -- requires updating connection status
getContactByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Contact getContactByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Contact
getContactByName db user@User {userId} localDisplayName = do getContactByName db user localDisplayName = do
cId <- getContactIdByName db user localDisplayName cId <- getContactIdByName db user localDisplayName
getContact db userId cId getContact db user cId
getUserContacts :: DB.Connection -> User -> IO [Contact] getUserContacts :: DB.Connection -> User -> IO [Contact]
getUserContacts db User {userId} = do getUserContacts db user@User {userId} = do
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ?" (Only userId) contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ?" (Only userId)
rights <$> mapM (runExceptT . getContact db userId) contactIds rights <$> mapM (runExceptT . getContact db user) contactIds
createUserContactLink :: DB.Connection -> UserId -> ConnId -> ConnReqContact -> ExceptT StoreError IO () createUserContactLink :: DB.Connection -> UserId -> ConnId -> ConnReqContact -> ExceptT StoreError IO ()
createUserContactLink db userId agentConnId cReq = createUserContactLink db userId agentConnId cReq =
@ -977,8 +990,8 @@ getGroupLinkId db User {userId} GroupInfo {groupId} =
fmap join . maybeFirstRow fromOnly $ fmap join . maybeFirstRow fromOnly $
DB.query db "SELECT group_link_id FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId) DB.query db "SELECT group_link_id FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)
createOrUpdateContactRequest :: DB.Connection -> UserId -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest
createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayName, fullName, image, preferences} xContactId_ = createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profile {displayName, fullName, image, preferences} xContactId_ =
liftIO (maybeM getContact' xContactId_) >>= \case liftIO (maybeM getContact' xContactId_) >>= \case
Just contact -> pure $ CORContact contact Just contact -> pure $ CORContact contact
Nothing -> CORRequest <$> createOrUpdate_ Nothing -> CORRequest <$> createOrUpdate_
@ -1014,7 +1027,7 @@ createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayN
insertedRowId db insertedRowId db
getContact' :: XContactId -> IO (Maybe Contact) getContact' :: XContactId -> IO (Maybe Contact)
getContact' xContactId = getContact' xContactId =
maybeFirstRow toContact $ maybeFirstRow (toContact user) $
DB.query DB.query
db db
[sql| [sql|
@ -1133,20 +1146,21 @@ deleteContactRequest db userId contactRequestId = do
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId) DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
createAcceptedContact :: DB.Connection -> User -> ConnId -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact createAcceptedContact :: DB.Connection -> User -> ConnId -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact
createAcceptedContact db User {userId, profile = LocalProfile {preferences}} agentConnId localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
createdAt <- getCurrentTime createdAt <- getCurrentTime
customUserProfileId <- forM incognitoProfile $ \case customUserProfileId <- forM incognitoProfile $ \case
NewIncognito p -> createIncognitoProfile_ db userId createdAt p NewIncognito p -> createIncognitoProfile_ db userId createdAt p
ExistingIncognito LocalProfile {profileId = pId} -> pure pId ExistingIncognito LocalProfile {profileId = pId} -> pure pId
let contactUserPrefs = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences let userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
DB.execute DB.execute
db db
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, xcontact_id) VALUES (?,?,?,?,?,?,?,?)" "INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, xcontact_id) VALUES (?,?,?,?,?,?,?,?)"
(userId, localDisplayName, profileId, True, contactUserPrefs, createdAt, createdAt, xContactId) (userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, xContactId)
contactId <- insertedRowId db contactId <- insertedRowId db
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing (Just userContactLinkId) customUserProfileId 0 createdAt activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing (Just userContactLinkId) customUserProfileId 0 createdAt
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences = contactUserPrefs, createdAt = createdAt, updatedAt = createdAt} let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt}
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer] getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
getLiveSndFileTransfers db User {userId} = do getLiveSndFileTransfers db User {userId} = do
@ -1249,8 +1263,8 @@ toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, v
Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. Only createdAt) Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. Only createdAt)
toMaybeConnection _ = Nothing toMaybeConnection _ = Nothing
getMatchingContacts :: DB.Connection -> UserId -> Contact -> IO [Contact] getMatchingContacts :: DB.Connection -> User -> Contact -> IO [Contact]
getMatchingContacts db userId Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do
contactIds <- contactIds <-
map fromOnly map fromOnly
<$> DB.query <$> DB.query
@ -1264,7 +1278,7 @@ getMatchingContacts db userId Contact {contactId, profile = LocalProfile {displa
AND ((p.image IS NULL AND ? IS NULL) OR p.image = ?) AND ((p.image IS NULL AND ? IS NULL) OR p.image = ?)
|] |]
(userId, contactId, displayName, fullName, image, image) (userId, contactId, displayName, fullName, image, image)
rights <$> mapM (runExceptT . getContact db userId) contactIds rights <$> mapM (runExceptT . getContact db user) contactIds
createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> Contact -> ExceptT StoreError IO (Probe, Int64) createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> Contact -> ExceptT StoreError IO (Probe, Int64)
createSentProbe db gVar userId _to@Contact {contactId} = createSentProbe db gVar userId _to@Contact {contactId} =
@ -1291,8 +1305,8 @@ deleteSentProbe db userId probeId =
"DELETE FROM sent_probes WHERE user_id = ? AND sent_probe_id = ?" "DELETE FROM sent_probes WHERE user_id = ? AND sent_probe_id = ?"
(userId, probeId) (userId, probeId)
matchReceivedProbe :: DB.Connection -> UserId -> Contact -> Probe -> IO (Maybe Contact) matchReceivedProbe :: DB.Connection -> User -> Contact -> Probe -> IO (Maybe Contact)
matchReceivedProbe db userId _from@Contact {contactId} (Probe probe) = do matchReceivedProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = do
let probeHash = C.sha256Hash probe let probeHash = C.sha256Hash probe
contactIds <- contactIds <-
map fromOnly map fromOnly
@ -1312,10 +1326,10 @@ matchReceivedProbe db userId _from@Contact {contactId} (Probe probe) = do
(contactId, probe, probeHash, userId, currentTs, currentTs) (contactId, probe, probeHash, userId, currentTs, currentTs)
case contactIds of case contactIds of
[] -> pure Nothing [] -> pure Nothing
cId : _ -> eitherToMaybe <$> runExceptT (getContact db userId cId) cId : _ -> eitherToMaybe <$> runExceptT (getContact db user cId)
matchReceivedProbeHash :: DB.Connection -> UserId -> Contact -> ProbeHash -> IO (Maybe (Contact, Probe)) matchReceivedProbeHash :: DB.Connection -> User -> Contact -> ProbeHash -> IO (Maybe (Contact, Probe))
matchReceivedProbeHash db userId _from@Contact {contactId} (ProbeHash probeHash) = do matchReceivedProbeHash db user@User {userId} _from@Contact {contactId} (ProbeHash probeHash) = do
namesAndProbes <- namesAndProbes <-
DB.query DB.query
db db
@ -1335,10 +1349,10 @@ matchReceivedProbeHash db userId _from@Contact {contactId} (ProbeHash probeHash)
[] -> pure Nothing [] -> pure Nothing
(cId, probe) : _ -> (cId, probe) : _ ->
either (const Nothing) (Just . (,Probe probe)) either (const Nothing) (Just . (,Probe probe))
<$> runExceptT (getContact db userId cId) <$> runExceptT (getContact db user cId)
matchSentProbe :: DB.Connection -> UserId -> Contact -> Probe -> IO (Maybe Contact) matchSentProbe :: DB.Connection -> User -> Contact -> Probe -> IO (Maybe Contact)
matchSentProbe db userId _from@Contact {contactId} (Probe probe) = do matchSentProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = do
contactIds <- contactIds <-
map fromOnly map fromOnly
<$> DB.query <$> DB.query
@ -1353,7 +1367,7 @@ matchSentProbe db userId _from@Contact {contactId} (Probe probe) = do
(userId, probe, contactId) (userId, probe, contactId)
case contactIds of case contactIds of
[] -> pure Nothing [] -> pure Nothing
cId : _ -> eitherToMaybe <$> runExceptT (getContact db userId cId) cId : _ -> eitherToMaybe <$> runExceptT (getContact db user cId)
mergeContactRecords :: DB.Connection -> UserId -> Contact -> Contact -> IO () mergeContactRecords :: DB.Connection -> UserId -> Contact -> Contact -> IO ()
mergeContactRecords db userId Contact {contactId = toContactId} Contact {contactId = fromContactId, localDisplayName} = do mergeContactRecords db userId Contact {contactId = toContactId} Contact {contactId = fromContactId, localDisplayName} = do
@ -1438,7 +1452,8 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)] = toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)] =
let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias} let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in Right $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, createdAt, updatedAt} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt}
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found" toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember) getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = ExceptT $ do getGroupAndMember_ groupMemberId c = ExceptT $ do
@ -1590,6 +1605,7 @@ updateConnectionStatus db Connection {connId} connStatus = do
createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> ExceptT StoreError IO GroupInfo createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> ExceptT StoreError IO GroupInfo
createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do
let GroupProfile {displayName, fullName, image, groupPreferences} = groupProfile let GroupProfile {displayName, fullName, image, groupPreferences} = groupProfile
fullGroupPreferences = mergeGroupPreferences groupPreferences
currentTs <- getCurrentTime currentTs <- getCurrentTime
withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
groupId <- liftIO $ do groupId <- liftIO $ do
@ -1606,7 +1622,7 @@ createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do
memberId <- liftIO $ encodedRandomBytes gVar 12 memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs
let chatSettings = ChatSettings {enableNtfs = True} let chatSettings = ChatSettings {enableNtfs = True}
pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs} pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs}
-- | creates a new group record for the group the current user was invited to, or returns an existing one -- | creates a new group record for the group the current user was invited to, or returns an existing one
createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
@ -1633,6 +1649,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, GroupMemberId) createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation_ = do createGroupInvitation_ = do
let GroupProfile {displayName, fullName, image, groupPreferences} = groupProfile let GroupProfile {displayName, fullName, image, groupPreferences} = groupProfile
fullGroupPreferences = mergeGroupPreferences groupPreferences
ExceptT $ ExceptT $
withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
currentTs <- liftIO getCurrentTime currentTs <- liftIO getCurrentTime
@ -1650,7 +1667,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs
membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs
let chatSettings = ChatSettings {enableNtfs = True} let chatSettings = ChatSettings {enableNtfs = True}
pure (GroupInfo {groupId, localDisplayName, groupProfile, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs}, groupMemberId) pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs}, groupMemberId)
getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
getHostMemberId_ db User {userId} groupId = getHostMemberId_ db User {userId} groupId =
@ -1805,7 +1822,8 @@ toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, image, hostConnCustomUserProfileId, enableNtfs_, groupPreferences, createdAt, updatedAt) :. userMemberRow) = toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, image, hostConnCustomUserProfileId, enableNtfs_, groupPreferences, createdAt, updatedAt) :. userMemberRow) =
let membership = toGroupMember userContactId userMemberRow let membership = toGroupMember userContactId userMemberRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName, image, groupPreferences}, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt} fullGroupPreferences = mergeGroupPreferences groupPreferences
in GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName, image, groupPreferences}, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt}
getGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember getGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMember db user@User {userId} groupId groupMemberId = getGroupMember db user@User {userId} groupId groupMemberId =
@ -1976,8 +1994,8 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
) )
getContactViaMember :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact) getContactViaMember :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact)
getContactViaMember db User {userId} GroupMember {groupMemberId} = getContactViaMember db user@User {userId} GroupMember {groupMemberId} =
maybeFirstRow toContact $ maybeFirstRow (toContact user) $
DB.query DB.query
db db
[sql| [sql|
@ -2102,7 +2120,7 @@ cleanupMemberContactAndProfile_ :: DB.Connection -> User -> GroupMember -> IO ()
cleanupMemberContactAndProfile_ db user@User {userId} m@GroupMember {groupMemberId, localDisplayName, memberContactId, memberContactProfileId, memberProfile = LocalProfile {profileId}} = cleanupMemberContactAndProfile_ db user@User {userId} m@GroupMember {groupMemberId, localDisplayName, memberContactId, memberContactProfileId, memberProfile = LocalProfile {profileId}} =
case memberContactId of case memberContactId of
Just contactId -> Just contactId ->
runExceptT (getContact db userId contactId) >>= \case runExceptT (getContact db user contactId) >>= \case
Right ct@Contact {activeConn = Connection {connLevel, viaGroupLink}, contactUsed} -> Right ct@Contact {activeConn = Connection {connLevel, viaGroupLink}, contactUsed} ->
unless ((connLevel == 0 && not viaGroupLink) || contactUsed) $ deleteContact db user ct unless ((connLevel == 0 && not viaGroupLink) || contactUsed) $ deleteContact db user ct
_ -> pure () _ -> pure ()
@ -2320,7 +2338,7 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow}) in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
getViaGroupContact :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact) getViaGroupContact :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact)
getViaGroupContact db User {userId} GroupMember {groupMemberId} = getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
maybeFirstRow toContact' $ maybeFirstRow toContact' $
DB.query DB.query
db db
@ -2347,7 +2365,8 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias} let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
activeConn = toConnection connRow activeConn = toConnection connRow
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, createdAt, updatedAt} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt}
createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> IO FileTransferMeta createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> IO FileTransferMeta
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize = do createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize = do
@ -2659,7 +2678,7 @@ getRcvFileTransfer db user@User {userId} fileId = do
rfi_ = \case rfi_ = \case
(Just filePath, Just connId, Just agentConnId, _, _, _, _) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId} (Just filePath, Just connId, Just agentConnId, _, _, _, _) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
(Just filePath, Nothing, Nothing, Just contactId, _, _, True) -> do (Just filePath, Nothing, Nothing, Just contactId, _, _, True) -> do
Contact {activeConn = Connection {connId, agentConnId}} <- getContact db userId contactId Contact {activeConn = Connection {connId, agentConnId}} <- getContact db user contactId
pure $ Just RcvFileInfo {filePath, connId, agentConnId} pure $ Just RcvFileInfo {filePath, connId, agentConnId}
(Just filePath, Nothing, Nothing, _, Just groupId, Just groupMemberId, True) -> do (Just filePath, Nothing, Nothing, _, Just groupId, Just groupMemberId, True) -> do
getGroupMember db user groupId groupMemberId >>= \case getGroupMember db user groupId groupMemberId >>= \case
@ -3194,7 +3213,7 @@ getChatPreviews db user withPCC = do
ts (AChat _ Chat {chatInfo}) = chatInfoUpdatedAt chatInfo ts (AChat _ Chat {chatInfo}) = chatInfoUpdatedAt chatInfo
getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChat] getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChat]
getDirectChatPreviews_ db User {userId} = do getDirectChatPreviews_ db user@User {userId} = do
tz <- getCurrentTimeZone tz <- getCurrentTimeZone
currentTs <- getCurrentTime currentTs <- getCurrentTime
map (toDirectChatPreview tz currentTs) map (toDirectChatPreview tz currentTs)
@ -3253,7 +3272,7 @@ getDirectChatPreviews_ db User {userId} = do
where where
toDirectChatPreview :: TimeZone -> UTCTime -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat toDirectChatPreview :: TimeZone -> UTCTime -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat
toDirectChatPreview tz currentTs (contactRow :. connRow :. statsRow :. ciRow_) = toDirectChatPreview tz currentTs (contactRow :. connRow :. statsRow :. ciRow_) =
let contact = toContact $ contactRow :. connRow let contact = toContact user $ contactRow :. connRow
ci_ = toDirectChatItemList tz currentTs ciRow_ ci_ = toDirectChatItemList tz currentTs ciRow_
stats = toChatStats statsRow stats = toChatStats statsRow
in AChat SCTDirect $ Chat (DirectChat contact) ci_ stats in AChat SCTDirect $ Chat (DirectChat contact) ci_ stats
@ -3420,8 +3439,8 @@ getDirectChat db user contactId pagination search_ = do
CPBefore beforeId count -> getDirectChatBefore_ db user contactId beforeId count search CPBefore beforeId count -> getDirectChatBefore_ db user contactId beforeId count search
getDirectChatLast_ :: DB.Connection -> User -> Int64 -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) getDirectChatLast_ :: DB.Connection -> User -> Int64 -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatLast_ db User {userId} contactId count search = do getDirectChatLast_ db user@User {userId} contactId count search = do
contact <- getContact db userId contactId contact <- getContact db user contactId
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItems <- ExceptT getDirectChatItemsLast_ chatItems <- ExceptT getDirectChatItemsLast_
pure $ Chat (DirectChat contact) (reverse chatItems) stats pure $ Chat (DirectChat contact) (reverse chatItems) stats
@ -3451,8 +3470,8 @@ getDirectChatLast_ db User {userId} contactId count search = do
(userId, contactId, search, count) (userId, contactId, search, count)
getDirectChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) getDirectChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ db User {userId} contactId afterChatItemId count search = do getDirectChatAfter_ db user@User {userId} contactId afterChatItemId count search = do
contact <- getContact db userId contactId contact <- getContact db user contactId
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItems <- ExceptT getDirectChatItemsAfter_ chatItems <- ExceptT getDirectChatItemsAfter_
pure $ Chat (DirectChat contact) chatItems stats pure $ Chat (DirectChat contact) chatItems stats
@ -3483,8 +3502,8 @@ getDirectChatAfter_ db User {userId} contactId afterChatItemId count search = do
(userId, contactId, search, afterChatItemId, count) (userId, contactId, search, afterChatItemId, count)
getDirectChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) getDirectChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ db User {userId} contactId beforeChatItemId count search = do getDirectChatBefore_ db user@User {userId} contactId beforeChatItemId count search = do
contact <- getContact db userId contactId contact <- getContact db user contactId
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItems <- ExceptT getDirectChatItemsBefore_ chatItems <- ExceptT getDirectChatItemsBefore_
pure $ Chat (DirectChat contact) (reverse chatItems) stats pure $ Chat (DirectChat contact) (reverse chatItems) stats
@ -3519,9 +3538,9 @@ getContactIdByName db User {userId} cName =
ExceptT . firstRow fromOnly (SEContactNotFoundByName cName) $ ExceptT . firstRow fromOnly (SEContactNotFoundByName cName) $
DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND local_display_name = ?" (userId, cName) DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND local_display_name = ?" (userId, cName)
getContact :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO Contact getContact :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Contact
getContact db userId contactId = getContact db user@User {userId} contactId =
ExceptT . fmap join . firstRow toContactOrError (SEContactNotFound contactId) $ ExceptT . fmap join . firstRow (toContactOrError user) (SEContactNotFound contactId) $
DB.query DB.query
db db
[sql| [sql|
@ -4076,7 +4095,7 @@ getChatItemByGroupId db user@User {userId} groupId = do
getAChatItem_ :: DB.Connection -> User -> ChatItemId -> ChatRef -> ExceptT StoreError IO AChatItem getAChatItem_ :: DB.Connection -> User -> ChatItemId -> ChatRef -> ExceptT StoreError IO AChatItem
getAChatItem_ db user@User {userId} itemId = \case getAChatItem_ db user@User {userId} itemId = \case
ChatRef CTDirect contactId -> do ChatRef CTDirect contactId -> do
ct <- getContact db userId contactId ct <- getContact db user contactId
(CChatItem msgDir ci) <- getDirectChatItem db userId contactId itemId (CChatItem msgDir ci) <- getDirectChatItem db userId contactId itemId
pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci
ChatRef CTGroup groupId -> do ChatRef CTGroup groupId -> do

132
src/Simplex/Chat/Types.hs
View File

@ -66,6 +66,7 @@ data User = User
userContactId :: ContactId, userContactId :: ContactId,
localDisplayName :: ContactName, localDisplayName :: ContactName,
profile :: LocalProfile, profile :: LocalProfile,
fullPreferences :: FullPreferences,
activeUser :: Bool activeUser :: Bool
} }
deriving (Show, Generic, FromJSON) deriving (Show, Generic, FromJSON)
@ -87,6 +88,7 @@ data Contact = Contact
contactUsed :: Bool, contactUsed :: Bool,
chatSettings :: ChatSettings, chatSettings :: ChatSettings,
userPreferences :: Preferences, userPreferences :: Preferences,
mergedPreferences :: ContactUserPreferences,
createdAt :: UTCTime, createdAt :: UTCTime,
updatedAt :: UTCTime updatedAt :: UTCTime
} }
@ -100,13 +102,10 @@ contactConn :: Contact -> Connection
contactConn = activeConn contactConn = activeConn
contactConnId :: Contact -> ConnId contactConnId :: Contact -> ConnId
contactConnId Contact {activeConn} = aConnId activeConn contactConnId = aConnId . contactConn
contactConnIncognito :: Contact -> Bool contactConnIncognito :: Contact -> Bool
contactConnIncognito = isJust . customUserProfileId' contactConnIncognito = connIncognito . contactConn
customUserProfileId' :: Contact -> Maybe Int64
customUserProfileId' Contact {activeConn} = customUserProfileId (activeConn :: Connection)
data ContactRef = ContactRef data ContactRef = ContactRef
{ contactId :: ContactId, { contactId :: ContactId,
@ -207,6 +206,7 @@ data GroupInfo = GroupInfo
{ groupId :: GroupId, { groupId :: GroupId,
localDisplayName :: GroupName, localDisplayName :: GroupName,
groupProfile :: GroupProfile, groupProfile :: GroupProfile,
fullGroupPreferences :: FullGroupPreferences,
membership :: GroupMember, membership :: GroupMember,
hostConnCustomUserProfileId :: Maybe ProfileId, hostConnCustomUserProfileId :: Maybe ProfileId,
chatSettings :: ChatSettings, chatSettings :: ChatSettings,
@ -293,6 +293,39 @@ data Preferences = Preferences
} }
deriving (Eq, Show, Generic, FromJSON) deriving (Eq, Show, Generic, FromJSON)
instance ToJSON Preferences where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
instance ToField Preferences where
toField = toField . encodeJSON
instance FromField Preferences where
fromField = fromTextField_ decodeJSON
groupPrefSel :: ChatFeature -> GroupPreferences -> Maybe GroupPreference
groupPrefSel = \case
CFFullDelete -> fullDelete
-- CFReceipts -> receipts
CFVoice -> voice
class GroupPreferenceI p where
getGroupPreference :: ChatFeature -> p -> GroupPreference
instance GroupPreferenceI GroupPreferences where
getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt prefs)
instance GroupPreferenceI (Maybe GroupPreferences) where
getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
instance GroupPreferenceI FullGroupPreferences where
getGroupPreference = \case
CFFullDelete -> fullDelete
-- CFReceipts -> receipts
CFVoice -> voice
{-# INLINE getGroupPreference #-}
-- collection of optional group preferences
data GroupPreferences = GroupPreferences data GroupPreferences = GroupPreferences
{ fullDelete :: Maybe GroupPreference, { fullDelete :: Maybe GroupPreference,
-- receipts :: Maybe GroupPreference, -- receipts :: Maybe GroupPreference,
@ -317,7 +350,20 @@ data FullPreferences = FullPreferences
-- receipts :: Preference, -- receipts :: Preference,
voice :: Preference voice :: Preference
} }
deriving (Eq) deriving (Eq, Show, Generic, FromJSON)
instance ToJSON FullPreferences where toEncoding = J.genericToEncoding J.defaultOptions
-- full collection of group preferences defined in the app - it is used to ensure we include all preferences and to simplify processing
-- if some of the preferences are not defined in GroupPreferences, defaults from defaultGroupPrefs are used here.
data FullGroupPreferences = FullGroupPreferences
{ fullDelete :: GroupPreference,
-- receipts :: GroupPreference,
voice :: GroupPreference
}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON FullGroupPreferences where toEncoding = J.genericToEncoding J.defaultOptions
-- merged preferences of user for a given contact - they differentiate between specific preferences for the contact and global user preferences -- merged preferences of user for a given contact - they differentiate between specific preferences for the contact and global user preferences
data ContactUserPreferences = ContactUserPreferences data ContactUserPreferences = ContactUserPreferences
@ -325,17 +371,17 @@ data ContactUserPreferences = ContactUserPreferences
-- receipts :: ContactUserPreference, -- receipts :: ContactUserPreference,
voice :: ContactUserPreference voice :: ContactUserPreference
} }
deriving (Show, Generic) deriving (Eq, Show, Generic)
data ContactUserPreference = ContactUserPreference data ContactUserPreference = ContactUserPreference
{ enabled :: PrefEnabled, { enabled :: PrefEnabled,
userPreference :: ContactUserPref, userPreference :: ContactUserPref,
contactPreference :: Preference contactPreference :: Preference
} }
deriving (Show, Generic) deriving (Eq, Show, Generic)
data ContactUserPref = CUPContact {preference :: Preference} | CUPUser {preference :: Preference} data ContactUserPref = CUPContact {preference :: Preference} | CUPUser {preference :: Preference}
deriving (Show, Generic) deriving (Eq, Show, Generic)
instance ToJSON ContactUserPreferences where toEncoding = J.genericToEncoding J.defaultOptions instance ToJSON ContactUserPreferences where toEncoding = J.genericToEncoding J.defaultOptions
@ -364,26 +410,24 @@ defaultChatPrefs =
emptyChatPrefs :: Preferences emptyChatPrefs :: Preferences
emptyChatPrefs = Preferences Nothing Nothing emptyChatPrefs = Preferences Nothing Nothing
instance ToJSON Preferences where defaultGroupPrefs :: FullGroupPreferences
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} defaultGroupPrefs =
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} FullGroupPreferences
{ fullDelete = GroupPreference {enable = FEOff},
instance ToField Preferences where -- receipts = GroupPreference {enable = FEOff},
toField = toField . encodeJSON voice = GroupPreference {enable = FEOn}
}
instance FromField Preferences where
fromField = fromTextField_ decodeJSON
data Preference = Preference data Preference = Preference
{allow :: FeatureAllowed} {allow :: FeatureAllowed}
deriving (Eq, Show, Generic, FromJSON) deriving (Eq, Show, Generic, FromJSON)
instance ToJSON Preference where toEncoding = J.genericToEncoding J.defaultOptions
data GroupPreference = GroupPreference data GroupPreference = GroupPreference
{enable :: GroupFeatureEnabled} {enable :: GroupFeatureEnabled}
deriving (Eq, Show, Generic, FromJSON) deriving (Eq, Show, Generic, FromJSON)
instance ToJSON Preference where toEncoding = J.genericToEncoding J.defaultOptions
instance ToJSON GroupPreference where toEncoding = J.genericToEncoding J.defaultOptions instance ToJSON GroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
data FeatureAllowed data FeatureAllowed
@ -392,9 +436,6 @@ data FeatureAllowed
| FANo -- do not allow | FANo -- do not allow
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
data GroupFeatureEnabled = FEOn | FEOff
deriving (Eq, Show, Generic)
instance FromField FeatureAllowed where fromField = fromBlobField_ strDecode instance FromField FeatureAllowed where fromField = fromBlobField_ strDecode
instance ToField FeatureAllowed where toField = toField . strEncode instance ToField FeatureAllowed where toField = toField . strEncode
@ -418,6 +459,9 @@ instance ToJSON FeatureAllowed where
toJSON = strToJSON toJSON = strToJSON
toEncoding = strToJEncoding toEncoding = strToJEncoding
data GroupFeatureEnabled = FEOn | FEOff
deriving (Eq, Show, Generic)
instance FromField GroupFeatureEnabled where fromField = fromBlobField_ strDecode instance FromField GroupFeatureEnabled where fromField = fromBlobField_ strDecode
instance ToField GroupFeatureEnabled where toField = toField . strEncode instance ToField GroupFeatureEnabled where toField = toField . strEncode
@ -452,12 +496,25 @@ mergePreferences contactPrefs userPreferences =
in fromMaybe (getPreference pt defaultChatPrefs) $ (contactPrefs >>= sel) <|> (userPreferences >>= sel) in fromMaybe (getPreference pt defaultChatPrefs) $ (contactPrefs >>= sel) <|> (userPreferences >>= sel)
mergeUserChatPrefs :: User -> Contact -> FullPreferences mergeUserChatPrefs :: User -> Contact -> FullPreferences
mergeUserChatPrefs user ct = mergeUserChatPrefs user ct = mergeUserChatPrefs' user (contactConnIncognito ct) (userPreferences ct)
let userPrefs = if contactConnIncognito ct then Nothing else preferences' user
in mergePreferences (Just $ userPreferences ct) userPrefs mergeUserChatPrefs' :: User -> Bool -> Preferences -> FullPreferences
mergeUserChatPrefs' user connectedIncognito userPreferences =
let userPrefs = if connectedIncognito then Nothing else preferences' user
in mergePreferences (Just userPreferences) userPrefs
mergeGroupPreferences :: Maybe GroupPreferences -> FullGroupPreferences
mergeGroupPreferences groupPreferences =
FullGroupPreferences
{ fullDelete = pref CFFullDelete,
-- receipts = pref CFReceipts,
voice = pref CFVoice
}
where
pref pt = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPreferences >>= groupPrefSel pt)
data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool} data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool}
deriving (Show, Generic) deriving (Eq, Show, Generic)
instance ToJSON PrefEnabled where instance ToJSON PrefEnabled where
toJSON = J.genericToJSON J.defaultOptions toJSON = J.genericToJSON J.defaultOptions
@ -471,8 +528,8 @@ prefEnabled Preference {allow = user} Preference {allow = contact} = case (user,
(FANo, _) -> PrefEnabled False False (FANo, _) -> PrefEnabled False False
_ -> PrefEnabled True True _ -> PrefEnabled True True
contactUserPreferences :: User -> Contact -> ContactUserPreferences contactUserPreferences :: User -> Preferences -> Maybe Preferences -> Bool -> ContactUserPreferences
contactUserPreferences user ct = contactUserPreferences user userPreferences contactPreferences connectedIncognito =
ContactUserPreferences ContactUserPreferences
{ fullDelete = pref CFFullDelete, { fullDelete = pref CFFullDelete,
-- receipts = pref CFReceipts, -- receipts = pref CFReceipts,
@ -483,19 +540,19 @@ contactUserPreferences user ct =
ContactUserPreference ContactUserPreference
{ enabled = prefEnabled userPref ctPref, { enabled = prefEnabled userPref ctPref,
-- incognito contact cannot have default user preference used -- incognito contact cannot have default user preference used
userPreference = if contactConnIncognito ct then CUPContact ctUserPref else maybe (CUPUser userPref) CUPContact ctUserPref_, userPreference = if connectedIncognito then CUPContact ctUserPref else maybe (CUPUser userPref) CUPContact ctUserPref_,
contactPreference = ctPref contactPreference = ctPref
} }
where where
ctUserPref = getPreference pt $ userPreferences ct ctUserPref = getPreference pt userPreferences
ctUserPref_ = chatPrefSel pt $ userPreferences ct ctUserPref_ = chatPrefSel pt userPreferences
userPref = getPreference pt ctUserPrefs userPref = getPreference pt ctUserPrefs
ctPref = getPreference pt ctPrefs ctPref = getPreference pt ctPrefs
ctUserPrefs = mergeUserChatPrefs user ct ctUserPrefs = mergeUserChatPrefs' user connectedIncognito userPreferences
ctPrefs = mergePreferences (preferences' ct) Nothing ctPrefs = mergePreferences contactPreferences Nothing
getContactUserPrefefence :: ChatFeature -> ContactUserPreferences -> ContactUserPreference getContactUserPreference :: ChatFeature -> ContactUserPreferences -> ContactUserPreference
getContactUserPrefefence = \case getContactUserPreference = \case
CFFullDelete -> fullDelete CFFullDelete -> fullDelete
-- CFReceipts -> receipts -- CFReceipts -> receipts
CFVoice -> voice CFVoice -> voice
@ -1144,6 +1201,9 @@ data Connection = Connection
aConnId :: Connection -> ConnId aConnId :: Connection -> ConnId
aConnId Connection {agentConnId = AgentConnId cId} = cId aConnId Connection {agentConnId = AgentConnId cId} = cId
connIncognito :: Connection -> Bool
connIncognito Connection {customUserProfileId} = isJust customUserProfileId
instance ToJSON Connection where instance ToJSON Connection where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}

18
src/Simplex/Chat/View.hs
View File

@ -125,13 +125,13 @@ responseToView user_ testView ts = \case
CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts
CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft
CRUserProfileUpdated p p' -> viewUserProfileUpdated p p' CRUserProfileUpdated p p' -> viewUserProfileUpdated p p'
CRContactPrefsUpdated {fromContact, toContact, preferences} -> case user_ of CRContactPrefsUpdated {fromContact, toContact} -> case user_ of
Just user -> viewUserContactPrefsUpdated user fromContact toContact preferences Just user -> viewUserContactPrefsUpdated user fromContact toContact
_ -> ["unexpected chat event CRContactPrefsUpdated without current user"] _ -> ["unexpected chat event CRContactPrefsUpdated without current user"]
CRContactAliasUpdated c -> viewContactAliasUpdated c CRContactAliasUpdated c -> viewContactAliasUpdated c
CRConnectionAliasUpdated c -> viewConnectionAliasUpdated c CRConnectionAliasUpdated c -> viewConnectionAliasUpdated c
CRContactUpdated {fromContact = c, toContact = c', preferences} -> case user_ of CRContactUpdated {fromContact = c, toContact = c'} -> case user_ of
Just user -> viewContactUpdated c c' <> viewContactPrefsUpdated user c c' preferences Just user -> viewContactUpdated c c' <> viewContactPrefsUpdated user c c'
_ -> ["unexpected chat event CRContactUpdated without current user"] _ -> ["unexpected chat event CRContactUpdated without current user"]
CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt
CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
@ -710,15 +710,15 @@ viewUserProfileUpdated Profile {displayName = n, fullName, image, preferences} P
| otherwise = ["user profile is changed to " <> ttyFullName n' fullName' <> notified] | otherwise = ["user profile is changed to " <> ttyFullName n' fullName' <> notified]
notified = " (your contacts are notified)" notified = " (your contacts are notified)"
viewUserContactPrefsUpdated :: User -> Contact -> Contact -> ContactUserPreferences -> [StyledString] viewUserContactPrefsUpdated :: User -> Contact -> Contact -> [StyledString]
viewUserContactPrefsUpdated user ct ct' cups viewUserContactPrefsUpdated user ct ct'@Contact {mergedPreferences = cups}
| null prefs = ["your preferences for " <> ttyContact' ct' <> " did not change"] | null prefs = ["your preferences for " <> ttyContact' ct' <> " did not change"]
| otherwise = ("you updated preferences for " <> ttyContact' ct' <> ":") : prefs | otherwise = ("you updated preferences for " <> ttyContact' ct' <> ":") : prefs
where where
prefs = viewContactPreferences user ct ct' cups prefs = viewContactPreferences user ct ct' cups
viewContactPrefsUpdated :: User -> Contact -> Contact -> ContactUserPreferences -> [StyledString] viewContactPrefsUpdated :: User -> Contact -> Contact -> [StyledString]
viewContactPrefsUpdated user ct ct' cups viewContactPrefsUpdated user ct ct'@Contact {mergedPreferences = cups}
| null prefs = [] | null prefs = []
| otherwise = (ttyContact' ct' <> " updated preferences for you:") : prefs | otherwise = (ttyContact' ct' <> " updated preferences for you:") : prefs
where where
@ -736,7 +736,7 @@ viewContactPref userPrefs userPrefs' ctPrefs cups pt
userPref = getPreference pt userPrefs userPref = getPreference pt userPrefs
userPref' = getPreference pt userPrefs' userPref' = getPreference pt userPrefs'
ctPref = getPreference pt ctPrefs ctPref = getPreference pt ctPrefs
ContactUserPreference {enabled, userPreference, contactPreference} = getContactUserPrefefence pt cups ContactUserPreference {enabled, userPreference, contactPreference} = getContactUserPreference pt cups
viewPrefsUpdated :: Maybe Preferences -> Maybe Preferences -> [StyledString] viewPrefsUpdated :: Maybe Preferences -> Maybe Preferences -> [StyledString]
viewPrefsUpdated ps ps' viewPrefsUpdated ps ps'

4
tests/MobileTests.hs
View File

@ -32,9 +32,9 @@ activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\"
activeUser :: String activeUser :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"activeUser\":true}}}}" activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"}},\"activeUser\":true}}}"
#else #else
activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"activeUser\":true}}}" activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"}},\"activeUser\":true}}}"
#endif #endif
chatStarted :: String chatStarted :: String