- New in v6.5.3:
-
- - relays reject groups that were removed, can be manually re-allowed
-
- New in v6.5:
+ New in v6.5.4:
Public channels - speak freely!
- Reliability: many relays per channel.
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 27b3fedae6..836cf56392 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -169,6 +169,12 @@ data ChatConfig = ChatConfig
chatHooks :: ChatHooks
}
+-- | Builds the read-only context threaded through store functions from chat config.
+-- The single construction point, so new store-wide config (e.g. server keys) is added in one place.
+mkStoreCxt :: ChatConfig -> StoreCxt
+mkStoreCxt ChatConfig {chatVRange} = StoreCxt chatVRange
+{-# INLINE mkStoreCxt #-}
+
data RandomAgentServers = RandomAgentServers
{ smpServers :: NonEmpty (ServerCfg 'PSMP),
xftpServers :: NonEmpty (ServerCfg 'PXFTP)
diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs
index 78af15c837..a220599fde 100644
--- a/src/Simplex/Chat/Library/Commands.hs
+++ b/src/Simplex/Chat/Library/Commands.hs
@@ -327,8 +327,8 @@ execChatCommand rh s retryNum =
execChatCommand' :: ChatCommand -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand' cmd retryNum = handleCommandError $ do
- vr <- chatVersionRange
- processChatCommand vr (NRMInteractive' retryNum) cmd
+ cxt <- chatStoreCxt
+ processChatCommand cxt (NRMInteractive' retryNum) cmd
execRemoteCommand :: RemoteHostId -> ChatCommand -> ByteString -> Int -> CM' (Either ChatError ChatResponse)
execRemoteCommand rhId cmd s retryNum = handleCommandError $ getRemoteHostClient rhId >>= \rh -> processRemoteCommand rhId rh cmd s retryNum
@@ -345,8 +345,8 @@ parseChatCommand :: ByteString -> Either String ChatCommand
parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace
-- | Chat API commands interpreted in context of a local zone
-processChatCommand :: VersionRangeChat -> NetworkRequestMode -> ChatCommand -> CM ChatResponse
-processChatCommand vr nm = \case
+processChatCommand :: StoreCxt -> NetworkRequestMode -> ChatCommand -> CM ChatResponse
+processChatCommand cxt nm = \case
ShowActiveUser -> withUser' $ pure . CRActiveUser
CreateActiveUser NewUser {profile, pastTimestamp, userChatRelay, clientService} -> do
forM_ profile $ \Profile {displayName} -> checkValidName displayName
@@ -412,26 +412,26 @@ processChatCommand vr nm = \case
SetActiveUser uName viewPwd_ -> do
tryAllErrors (withFastStore (`getUserIdByName` uName)) >>= \case
Left _ -> throwChatError CEUserUnknown
- Right userId -> processChatCommand vr nm $ APISetActiveUser userId viewPwd_
+ Right userId -> processChatCommand cxt nm $ APISetActiveUser userId viewPwd_
SetAllContactReceipts onOff -> withUser $ \_ -> withFastStore' (`updateAllContactReceipts` onOff) >> ok_
APISetUserContactReceipts userId' settings -> withUser $ \user -> do
user' <- privateGetUser userId'
validateUserPassword user user' Nothing
withFastStore' $ \db -> updateUserContactReceipts db user' settings
ok user
- SetUserContactReceipts settings -> withUser $ \User {userId} -> processChatCommand vr nm $ APISetUserContactReceipts userId settings
+ SetUserContactReceipts settings -> withUser $ \User {userId} -> processChatCommand cxt nm $ APISetUserContactReceipts userId settings
APISetUserGroupReceipts userId' settings -> withUser $ \user -> do
user' <- privateGetUser userId'
validateUserPassword user user' Nothing
withFastStore' $ \db -> updateUserGroupReceipts db user' settings
ok user
- SetUserGroupReceipts settings -> withUser $ \User {userId} -> processChatCommand vr nm $ APISetUserGroupReceipts userId settings
+ SetUserGroupReceipts settings -> withUser $ \User {userId} -> processChatCommand cxt nm $ APISetUserGroupReceipts userId settings
APISetUserAutoAcceptMemberContacts userId' onOff -> withUser $ \user -> do
user' <- privateGetUser userId'
validateUserPassword user user' Nothing
withFastStore' $ \db -> updateUserAutoAcceptMemberContacts db user' onOff
ok user
- SetUserAutoAcceptMemberContacts onOff -> withUser $ \User {userId} -> processChatCommand vr nm $ APISetUserAutoAcceptMemberContacts userId onOff
+ SetUserAutoAcceptMemberContacts onOff -> withUser $ \User {userId} -> processChatCommand cxt nm $ APISetUserAutoAcceptMemberContacts userId onOff
APIHideUser userId' (UserPwd viewPwd) -> withUser $ \user -> do
user' <- privateGetUser userId'
case viewPwdHash user' of
@@ -457,10 +457,10 @@ processChatCommand vr nm = \case
setUserPrivacy user user' {viewPwdHash = Nothing, showNtfs = True}
APIMuteUser userId' -> setUserNotifications userId' False
APIUnmuteUser userId' -> setUserNotifications userId' True
- HideUser viewPwd -> withUser $ \User {userId} -> processChatCommand vr nm $ APIHideUser userId viewPwd
- UnhideUser viewPwd -> withUser $ \User {userId} -> processChatCommand vr nm $ APIUnhideUser userId viewPwd
- MuteUser -> withUser $ \User {userId} -> processChatCommand vr nm $ APIMuteUser userId
- UnmuteUser -> withUser $ \User {userId} -> processChatCommand vr nm $ APIUnmuteUser userId
+ HideUser viewPwd -> withUser $ \User {userId} -> processChatCommand cxt nm $ APIHideUser userId viewPwd
+ UnhideUser viewPwd -> withUser $ \User {userId} -> processChatCommand cxt nm $ APIUnhideUser userId viewPwd
+ MuteUser -> withUser $ \User {userId} -> processChatCommand cxt nm $ APIMuteUser userId
+ UnmuteUser -> withUser $ \User {userId} -> processChatCommand cxt nm $ APIUnmuteUser userId
SetClientService userId' name enable -> checkChatStopped $ withUser' $ \currUser@User {userId} -> do
user@User {agentUserId = AgentUserId auId, clientService, profile = LocalProfile {displayName}} <-
if userId == userId' then pure currUser else privateGetUser userId'
@@ -543,7 +543,7 @@ processChatCommand vr nm = \case
ExportArchive -> do
ts <- liftIO getCurrentTime
let filePath = "simplex-chat." <> formatTime defaultTimeLocale "%FT%H%M%SZ" ts <> ".zip"
- processChatCommand vr nm $ APIExportArchive $ ArchiveConfig filePath Nothing Nothing
+ processChatCommand cxt nm $ APIExportArchive $ ArchiveConfig filePath Nothing Nothing
APIImportArchive cfg -> checkChatStopped $ do
fileErrs <- lift $ importArchive cfg
setStoreChanged
@@ -572,16 +572,16 @@ processChatCommand vr nm = \case
tags <- withFastStore' (`getUserChatTags` user)
pure $ CRChatTags user tags
APIGetChats {userId, pendingConnections, pagination, query} -> withUserId' userId $ \user -> do
- (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db vr user pendingConnections pagination query)
+ (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db cxt user pendingConnections pagination query)
unless (null errs) $ toView $ CEvtChatErrors (map ChatErrorStore errs)
pure $ CRApiChats user previews
APIGetChat (ChatRef cType cId scope_) contentFilter pagination search -> withUser $ \user -> case cType of
-- TODO optimize queries calculating ChatStats, currently they're disabled
CTDirect -> do
- (directChat, navInfo) <- withFastStore (\db -> getDirectChat db vr user cId contentFilter pagination search)
+ (directChat, navInfo) <- withFastStore (\db -> getDirectChat db cxt user cId contentFilter pagination search)
pure $ CRApiChat user (AChat SCTDirect directChat) navInfo
CTGroup -> do
- (groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId scope_ contentFilter pagination search)
+ (groupChat, navInfo) <- withFastStore (\db -> getGroupChat db cxt user cId scope_ contentFilter pagination search)
groupChat' <- checkSupportChatAttention user groupChat
pure $ CRApiChat user (AChat SCTGroup groupChat') navInfo
CTLocal -> do
@@ -597,7 +597,7 @@ processChatCommand vr nm = \case
case correctedMemAttention (groupMemberId' scopeMem) suppChat chatItems of
Just newMemAttention -> do
(gInfo', scopeMem') <-
- withFastStore' $ \db -> setSupportChatMemberAttention db vr user gInfo scopeMem newMemAttention
+ withFastStore' $ \db -> setSupportChatMemberAttention db cxt user gInfo scopeMem newMemAttention
pure (groupChat {chatInfo = GroupChat gInfo' (Just $ GCSIMemberSupport (Just scopeMem'))} :: Chat 'CTGroup)
Nothing -> pure groupChat
_ -> pure groupChat
@@ -614,11 +614,11 @@ processChatCommand vr nm = \case
APIGetChatContentTypes chatRef -> withUser $ \user ->
CRChatContentTypes <$> withStore (\db -> getChatContentTypes db user chatRef)
APIGetChatItems pagination search -> withUser $ \user -> do
- chatItems <- withFastStore $ \db -> getAllChatItems db vr user pagination search
+ chatItems <- withFastStore $ \db -> getAllChatItems db cxt user pagination search
pure $ CRChatItems user Nothing chatItems
APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do
(aci@(AChatItem cType dir _ ci), versions) <- withFastStore $ \db ->
- (,) <$> getAChatItem db vr user chatRef itemId <*> liftIO (getChatItemVersions db itemId)
+ (,) <$> getAChatItem db cxt user chatRef itemId <*> liftIO (getChatItemVersions db itemId)
let itemVersions = if null versions then maybeToList $ mkItemVersion ci else versions
memberDeliveryStatuses <- case (cType, dir) of
(SCTGroup, SMDSnd) -> L.nonEmpty <$> withFastStore' (`getGroupSndStatuses` itemId)
@@ -629,10 +629,10 @@ processChatCommand vr nm = \case
getForwardedFromItem :: User -> ChatItem c d -> CM (Maybe AChatItem)
getForwardedFromItem user ChatItem {meta = CIMeta {itemForwarded}} = case itemForwarded of
Just (CIFFContact _ _ (Just ctId) (Just fwdItemId)) ->
- Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTDirect ctId Nothing) fwdItemId)
+ Just <$> withFastStore (\db -> getAChatItem db cxt user (ChatRef CTDirect ctId Nothing) fwdItemId)
Just (CIFFGroup _ _ (Just gId) (Just fwdItemId)) ->
-- TODO [knocking] getAChatItem doesn't differentiate how to read based on scope - it should, instead of using group filter
- Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTGroup gId Nothing) fwdItemId)
+ Just <$> withFastStore (\db -> getAChatItem db cxt user (ChatRef CTGroup gId Nothing) fwdItemId)
_ -> pure Nothing
APISendMessages sendRef live itemTTL cms -> withUser $ \user -> mapM_ assertAllowedContent' cms >> case sendRef of
SRDirect chatId -> do
@@ -645,7 +645,7 @@ processChatCommand vr nm = \case
Nothing -> pure ()
withGroupLock "sendMessage" chatId $ do
(gInfo, cmrs) <- withFastStore $ \db -> do
- g <- getGroupInfo db vr user chatId
+ g <- getGroupInfo db cxt user chatId
(g,) <$> mapM (composedMessageReqMentions db user g) cms
sendGroupContentMessages user gInfo gsScope asGroup live itemTTL cmrs
APICreateChatTag (ChatTagData emoji text) -> withUser $ \user -> withFastStore' $ \db -> do
@@ -673,18 +673,18 @@ processChatCommand vr nm = \case
createNoteFolderContentItems user folderId (L.map composedMessageReq cms)
APIReportMessage gId reportedItemId reportReason reportText -> withUser $ \user ->
withGroupLock "reportMessage" gId $ do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user gId
let mc = MCReport reportText reportReason
cm = ComposedMessage {fileSource = Nothing, quotedItemId = Just reportedItemId, msgContent = mc, mentions = M.empty}
sendGroupContentMessages user gInfo (Just $ GCSMemberSupport Nothing) False False Nothing [composedMessageReq cm]
ReportMessage {groupName, contactName_, reportReason, reportedMessage} -> withUser $ \user -> do
gId <- withFastStore $ \db -> getGroupIdByName db user groupName
reportedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user gId contactName_ reportedMessage
- processChatCommand vr nm $ APIReportMessage gId reportedItemId reportReason ""
+ processChatCommand cxt nm $ APIReportMessage gId reportedItemId reportReason ""
APIUpdateChatItem (ChatRef cType chatId scope) itemId live (UpdatedMessage mc mentions) -> withUser $ \user -> assertAllowedContent mc >> case cType of
CTDirect -> withContactLock "updateChatItem" chatId $ do
unless (null mentions) $ throwCmdError "mentions are not supported in this chat"
- ct@Contact {contactId} <- withFastStore $ \db -> getContact db vr user chatId
+ ct@Contact {contactId} <- withFastStore $ \db -> getContact db cxt user chatId
assertDirectAllowed user MDSnd ct XMsgUpdate_
cci <- withFastStore $ \db -> getDirectCIWithReactions db user ct itemId
case cci of
@@ -708,7 +708,7 @@ processChatCommand vr nm = \case
_ -> throwChatError CEInvalidChatItemUpdate
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
CTGroup -> withGroupLock "updateChatItem" chatId $ do
- gInfo@GroupInfo {groupId, membership} <- withFastStore $ \db -> getGroupInfo db vr user chatId
+ gInfo@GroupInfo {groupId, membership} <- withFastStore $ \db -> getGroupInfo db cxt user chatId
when (isNothing scope) $ assertUserGroupRole gInfo GRAuthor
let (_, ft_) = msgContentTexts mc
if prohibitedSimplexLinks gInfo membership mc ft_
@@ -720,8 +720,8 @@ processChatCommand vr nm = \case
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable, showGroupAsSender}, content = ciContent} -> do
case (ciContent, itemSharedMsgId, editable) of
(CISndMsgContent oldMC, Just itemSharedMId, True) -> do
- chatScopeInfo <- mapM (getChatScopeInfo vr user) scope
- recipients <- getGroupRecipients vr user gInfo chatScopeInfo groupKnockingVersion
+ chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope
+ recipients <- getGroupRecipients cxt user gInfo chatScopeInfo groupKnockingVersion
let changed = mc /= oldMC
if changed || fromMaybe False itemLive
then do
@@ -777,7 +777,7 @@ processChatCommand vr nm = \case
CTGroup -> withGroupLock "deleteChatItem" chatId $ do
(gInfo, items) <- getCommandGroupChatItems user chatId itemIds
-- TODO [knocking] check scope for all items?
- chatScopeInfo <- mapM (getChatScopeInfo vr user) scope
+ chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope
deletions <- case mode of
CIDMInternal
| publicGroupEditor gInfo (membership gInfo) -> throwChatError CEInvalidChatItemDelete
@@ -785,7 +785,7 @@ processChatCommand vr nm = \case
CIDMInternalMark -> do
markGroupCIsDeleted user gInfo chatScopeInfo items Nothing =<< liftIO getCurrentTime
CIDMBroadcast -> do
- recipients <- getGroupRecipients vr user gInfo chatScopeInfo groupKnockingVersion
+ recipients <- getGroupRecipients cxt user gInfo chatScopeInfo groupKnockingVersion
assertDeletable items
assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
let msgIds = itemsMsgIds items
@@ -794,7 +794,7 @@ processChatCommand vr nm = \case
delGroupChatItems user gInfo chatScopeInfo items False
CIDMHistory -> do
unless (publicGroupEditor gInfo (membership gInfo)) $ throwChatError CEInvalidChatItemDelete
- recipients <- getGroupRecipients vr user gInfo chatScopeInfo groupKnockingVersion
+ recipients <- getGroupRecipients cxt user gInfo chatScopeInfo groupKnockingVersion
let msgIds = itemsMsgIds items
events = L.nonEmpty $ map (\msgId -> XMsgDel msgId Nothing (toMsgScope gInfo <$> chatScopeInfo) True) msgIds
mapM_ (sendGroupMessages user gInfo Nothing False recipients) events
@@ -822,12 +822,12 @@ processChatCommand vr nm = \case
APIDeleteMemberChatItem gId itemIds -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do
(gInfo, items) <- getCommandGroupChatItems user gId itemIds
-- TODO [knocking] check scope is Nothing for all items? (prohibit moderation in support chats?)
- ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
+ ms <- withFastStore' $ \db -> getGroupMembers db cxt user gInfo
let recipients = filter memberCurrent ms
deletions <- delGroupChatItemsForMembers user gInfo Nothing recipients items
pure $ CRChatItemsDeleted user deletions True False
APIArchiveReceivedReports gId -> withUser $ \user -> withFastStore $ \db -> do
- g <- getGroupInfo db vr user gId
+ g <- getGroupInfo db cxt user gId
deleteTs <- liftIO getCurrentTime
ciIds <- liftIO $ markReceivedGroupReportsDeleted db user g deleteTs
pure $ CRGroupChatItemsDeleted user g ciIds True (Just $ membership g)
@@ -841,7 +841,7 @@ processChatCommand vr nm = \case
CIDMInternalMark -> markGroupCIsDeleted user gInfo Nothing items Nothing =<< liftIO getCurrentTime
CIDMHistory -> throwChatError CEInvalidChatItemDelete
CIDMBroadcast -> do
- ms <- withFastStore' $ \db -> getGroupModerators db vr user gInfo
+ ms <- withFastStore' $ \db -> getGroupModerators db cxt user gInfo
let recipients = filter memberCurrent ms
delGroupChatItemsForMembers user gInfo Nothing recipients items
pure $ CRChatItemsDeleted user deletions True False
@@ -852,7 +852,7 @@ processChatCommand vr nm = \case
APIChatItemReaction (ChatRef cType chatId scope) itemId add reaction -> withUser $ \user -> case cType of
CTDirect ->
withContactLock "chatItemReaction" chatId $
- withFastStore (\db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId) >>= \case
+ withFastStore (\db -> (,) <$> getContact db cxt user chatId <*> getDirectChatItem db user chatId itemId) >>= \case
(ct, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
unless (featureAllowed SCFReactions forUser ct) $
throwCmdError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)
@@ -873,10 +873,10 @@ processChatCommand vr nm = \case
withGroupLock "chatItemReaction" chatId $ do
-- TODO [knocking] check chat item scope?
(g@GroupInfo {membership}, CChatItem md ci) <- withFastStore $ \db -> do
- g <- getGroupInfo db vr user chatId
+ g <- getGroupInfo db cxt user chatId
(g,) <$> getGroupCIWithReactions db user g itemId
- chatScopeInfo <- mapM (getChatScopeInfo vr user) scope
- recipients <- getGroupRecipients vr user g chatScopeInfo groupKnockingVersion
+ chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope
+ recipients <- getGroupRecipients cxt user g chatScopeInfo groupKnockingVersion
case ci of
ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}} -> do
unless (groupFeatureAllowed SGFReactions g) $
@@ -907,7 +907,7 @@ processChatCommand vr nm = \case
APIGetReactionMembers userId groupId itemId reaction -> withUserId userId $ \user -> do
memberReactions <- withStore $ \db -> do
CChatItem _ ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}} <- getGroupChatItem db user groupId itemId
- liftIO $ getReactionMembers db vr user groupId itemSharedMId reaction
+ liftIO $ getReactionMembers db cxt user groupId itemSharedMId reaction
pure $ CRReactionMembers user memberReactions
-- TODO [knocking] forward from scope?
APIPlanForwardChatItems (ChatRef fromCType fromChatId _scope) itemIds -> withUser $ \user -> case fromCType of
@@ -971,7 +971,7 @@ processChatCommand vr nm = \case
case L.nonEmpty cmrs of
Just cmrs' ->
withGroupLock "forwardChatItem, to group" toChatId $ do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user toChatId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user toChatId
sendGroupContentMessages user gInfo toScope sendAsGroup False itemTTL cmrs'
Nothing -> pure $ CRNewChatItems user []
CTLocal -> do
@@ -1105,7 +1105,7 @@ processChatCommand vr nm = \case
pure $ prefix <> formattedDate <> ext
APIShareChatMsgContent (ChatRef CTGroup groupId _) toSendRef -> withUser $ \user -> do
GroupInfo {groupProfile = gp@GroupProfile {publicGroup}, membership = GroupMember {memberId, memberRole}, groupKeys} <-
- withFastStore $ \db -> getGroupInfo db vr user groupId
+ withFastStore $ \db -> getGroupInfo db cxt user groupId
case publicGroup of
Nothing -> throwCmdError "not a public group"
Just PublicGroupProfile {groupLink} -> do
@@ -1127,11 +1127,11 @@ processChatCommand vr nm = \case
shareChatBinding :: User -> SendRef -> CM (Maybe (ChatBinding, ByteString))
shareChatBinding u = \case
SRDirect contactId -> do
- ct <- withFastStore $ \db -> getContact db vr u contactId
+ ct <- withFastStore $ \db -> getContact db cxt u contactId
forM (contactConn ct) $ \conn ->
(CBDirect,) <$> withAgent (`getConnectionRatchetAdHash` aConnId conn)
SRGroup toGroupId _ asGroup -> do
- GroupInfo {groupProfile = GroupProfile {publicGroup}, membership = m} <- withFastStore $ \db -> getGroupInfo db vr u toGroupId
+ GroupInfo {groupProfile = GroupProfile {publicGroup}, membership = m} <- withFastStore $ \db -> getGroupInfo db cxt u toGroupId
pure $ mkBinding m <$> publicGroup
where
mkBinding GroupMember {memberId} PublicGroupProfile {publicGroupId = pgId}
@@ -1139,7 +1139,7 @@ processChatCommand vr nm = \case
| otherwise = (CBGroup, smpEncode (pgId, memberId))
APIShareChatMsgContent _ _ -> throwCmdError "sharing is only supported for public groups"
APIUserRead userId -> withUserId userId $ \user -> withFastStore' (`setUserChatsRead` user) >> ok user
- UserRead -> withUser $ \User {userId} -> processChatCommand vr nm $ APIUserRead userId
+ UserRead -> withUser $ \User {userId} -> processChatCommand cxt nm $ APIUserRead userId
APIChatRead chatRef@(ChatRef cType chatId scope_) -> withUser $ \_ -> case cType of
CTDirect -> do
user <- withFastStore $ \db -> getUserByContactId db chatId
@@ -1153,7 +1153,7 @@ processChatCommand vr nm = \case
CTGroup -> do
(user, gInfo) <- withFastStore $ \db -> do
user <- getUserByGroupId db chatId
- gInfo <- getGroupInfo db vr user chatId
+ gInfo <- getGroupInfo db cxt user chatId
pure (user, gInfo)
ts <- liftIO getCurrentTime
case scope_ of
@@ -1165,10 +1165,10 @@ processChatCommand vr nm = \case
forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt
ok user
Just scope -> do
- scopeInfo <- getChatScopeInfo vr user scope
+ scopeInfo <- getChatScopeInfo cxt user scope
(gInfo', m', timedItems) <- withFastStore' $ \db -> do
timedItems <- getGroupUnreadTimedItems db user chatId (Just scope)
- (gInfo', m') <- updateSupportChatItemsRead db vr user gInfo scopeInfo
+ (gInfo', m') <- updateSupportChatItemsRead db cxt user gInfo scopeInfo
timedItems' <- setGroupChatItemsDeleteAt db user chatId timedItems ts
pure (gInfo', m', timedItems')
forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt
@@ -1183,7 +1183,7 @@ processChatCommand vr nm = \case
CTDirect -> do
(user, ct) <- withFastStore $ \db -> do
user <- getUserByContactId db chatId
- ct <- getContact db vr user chatId
+ ct <- getContact db cxt user chatId
pure (user, ct)
timedItems <- withFastStore' $ \db -> do
timedItems <- updateDirectChatItemsReadList db user chatId itemIds
@@ -1193,11 +1193,11 @@ processChatCommand vr nm = \case
CTGroup -> do
(user, gInfo) <- withFastStore $ \db -> do
user <- getUserByGroupId db chatId
- gInfo <- getGroupInfo db vr user chatId
+ gInfo <- getGroupInfo db cxt user chatId
pure (user, gInfo)
- chatScopeInfo <- mapM (getChatScopeInfo vr user) scope
+ chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope
(timedItems, gInfo') <- withFastStore $ \db -> do
- (timedItems, gInfo') <- updateGroupChatItemsReadList db vr user gInfo chatScopeInfo itemIds
+ (timedItems, gInfo') <- updateGroupChatItemsReadList db cxt user gInfo chatScopeInfo itemIds
timedItems' <- liftIO $ setGroupChatItemsDeleteAt db user chatId timedItems =<< getCurrentTime
pure (timedItems', gInfo')
forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt
@@ -1208,13 +1208,13 @@ processChatCommand vr nm = \case
APIChatUnread (ChatRef cType chatId scope) unreadChat -> withUser $ \user -> case cType of
CTDirect -> do
withFastStore $ \db -> do
- ct <- getContact db vr user chatId
+ ct <- getContact db cxt user chatId
liftIO $ updateContactUnreadChat db user ct unreadChat
ok user
-- TODO [knocking] set support chat as unread?
CTGroup | isNothing scope -> do
withFastStore $ \db -> do
- gInfo <- getGroupInfo db vr user chatId
+ gInfo <- getGroupInfo db cxt user chatId
liftIO $ updateGroupUnreadChat db user gInfo unreadChat
ok user
CTLocal -> do
@@ -1225,7 +1225,7 @@ processChatCommand vr nm = \case
_ -> throwCmdError "not supported"
APIDeleteChat cRef@(ChatRef cType chatId scope) cdm -> withUser $ \user@User {userId} -> case cType of
CTDirect -> do
- ct <- withFastStore $ \db -> getContact db vr user chatId
+ ct <- withFastStore $ \db -> getContact db cxt user chatId
filesInfo <- withFastStore' $ \db -> getContactFileInfo db user ct
withContactLock "deleteChat direct" chatId $
case cdm of
@@ -1245,17 +1245,17 @@ processChatCommand vr nm = \case
ct' <- withFastStore $ \db -> do
liftIO $ deleteContactConnections db user ct
liftIO $ void $ updateContactStatus db user ct CSDeletedByUser
- getContact db vr user chatId
+ getContact db cxt user chatId
pure $ CRContactDeleted user ct'
CDMMessages -> do
- void $ processChatCommand vr nm $ APIClearChat cRef
+ void $ processChatCommand cxt nm $ APIClearChat cRef
withFastStore' $ \db -> setContactChatDeleted db user ct True
pure $ CRContactDeleted user ct {chatDeleted = True}
where
sendDelDeleteConns ct notify = do
let doSendDel = contactReady ct && contactActive ct && notify
when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchAllErrors` const (pure ())
- contactConnIds <- map aConnId <$> withFastStore' (\db -> getContactConnections db vr userId ct)
+ contactConnIds <- map aConnId <$> withFastStore' (\db -> getContactConnections db cxt userId ct)
deleteAgentConnectionsAsync' contactConnIds doSendDel
CTContactConnection -> withConnectionLock "deleteChat contactConnection" chatId $ do
conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withFastStore $ \db -> getPendingContactConnection db userId chatId
@@ -1263,7 +1263,7 @@ processChatCommand vr nm = \case
withFastStore' $ \db -> deletePendingContactConnection db userId chatId
pure $ CRContactConnectionDeleted user conn
CTGroup | isNothing scope -> do
- gInfo@GroupInfo {membership} <- withFastStore $ \db -> getGroupInfo db vr user chatId
+ gInfo@GroupInfo {membership} <- withFastStore $ \db -> getGroupInfo db cxt user chatId
let isOwner = memberRole' membership == GROwner
canDelete = isOwner || not (memberCurrent membership)
unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner
@@ -1287,25 +1287,25 @@ processChatCommand vr nm = \case
where
getRecipients gInfo
| useRelays' gInfo = do
- relays <- withFastStore' $ \db -> getGroupRelayMembers db vr user gInfo
+ relays <- withFastStore' $ \db -> getGroupRelayMembers db cxt user gInfo
pure (relays, relays)
| otherwise = do
- ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
+ ms <- withFastStore' $ \db -> getGroupMembers db cxt user gInfo
pure (ms, filter memberCurrentOrPending ms)
_ -> throwCmdError "not supported"
APIClearChat (ChatRef cType chatId scope) -> withUser $ \user@User {userId} -> case cType of
CTDirect -> do
- ct <- withFastStore $ \db -> getContact db vr user chatId
+ ct <- withFastStore $ \db -> getContact db cxt user chatId
filesInfo <- withFastStore' $ \db -> getContactFileInfo db user ct
deleteCIFiles user filesInfo
withFastStore' $ \db -> deleteContactCIs db user ct
pure $ CRChatCleared user (AChatInfo SCTDirect $ DirectChat ct)
CTGroup | isNothing scope -> do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user chatId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user chatId
filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo
deleteCIFiles user filesInfo
withFastStore' $ \db -> deleteGroupChatItemsMessages db user gInfo
- membersToDelete <- withFastStore' $ \db -> getGroupMembersForExpiration db vr user gInfo
+ membersToDelete <- withFastStore' $ \db -> getGroupMembersForExpiration db cxt user gInfo
forM_ membersToDelete $ \m -> withFastStore' $ \db -> deleteGroupMember db user m
pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo Nothing)
CTLocal -> do
@@ -1366,7 +1366,7 @@ processChatCommand vr nm = \case
withFastStore $ \db -> do
cReq@UserContactRequest {contactId_} <- getContactRequest db user connReqId
ct_ <- forM contactId_ $ \contactId -> do
- ct <- getContact db vr user contactId
+ ct <- getContact db cxt user contactId
deleteContact db user ct
pure ct
liftIO $ deleteContactRequest db user connReqId
@@ -1375,7 +1375,7 @@ processChatCommand vr nm = \case
pure $ CRContactRequestRejected user cReq ct_
APISendCallInvitation contactId callType -> withUser $ \user -> do
-- party initiating call
- ct <- withFastStore $ \db -> getContact db vr user contactId
+ ct <- withFastStore $ \db -> getContact db cxt user contactId
assertDirectAllowed user MDSnd ct XCallInv_
if featureAllowed SCFCalls forUser ct
then do
@@ -1397,7 +1397,7 @@ processChatCommand vr nm = \case
else throwCmdError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFCalls)
SendCallInvitation cName callType -> withUser $ \user -> do
contactId <- withFastStore $ \db -> getContactIdByName db user cName
- processChatCommand vr nm $ APISendCallInvitation contactId callType
+ processChatCommand cxt nm $ APISendCallInvitation contactId callType
APIRejectCall contactId ->
-- party accepting call
withCurrentCall contactId $ \user ct Call {chatItemId, callState} -> case callState of
@@ -1464,23 +1464,23 @@ processChatCommand vr nm = \case
_ -> Nothing
rcvCallInvitation (contactId, callUUID, callTs, peerCallType, sharedKey) = runExceptT . withFastStore $ \db -> do
user <- getUserByContactId db contactId
- contact <- getContact db vr user contactId
+ contact <- getContact db cxt user contactId
pure RcvCallInvitation {user, contact, callType = peerCallType, sharedKey, callUUID, callTs}
APICallStatus contactId receivedStatus ->
withCurrentCall contactId $ \user ct call ->
updateCallItemStatus user ct call receivedStatus Nothing $> Just call
APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile)
APISetContactPrefs contactId prefs' -> withUser $ \user -> do
- ct <- withFastStore $ \db -> getContact db vr user contactId
+ ct <- withFastStore $ \db -> getContact db cxt user contactId
updateContactPrefs user ct prefs'
APISetContactAlias contactId localAlias -> withUser $ \user@User {userId} -> do
ct' <- withFastStore $ \db -> do
- ct <- getContact db vr user contactId
+ ct <- getContact db cxt user contactId
liftIO $ updateContactAlias db userId ct localAlias
pure $ CRContactAliasUpdated user ct'
APISetGroupAlias gId localAlias -> withUser $ \user@User {userId} -> do
gInfo' <- withFastStore $ \db -> do
- gInfo <- getGroupInfo db vr user gId
+ gInfo <- getGroupInfo db cxt user gId
liftIO $ updateGroupAlias db userId gInfo localAlias
pure $ CRGroupAliasUpdated user gInfo'
APISetConnectionAlias connId localAlias -> withUser $ \user@User {userId} -> do
@@ -1498,23 +1498,23 @@ processChatCommand vr nm = \case
APISetChatUIThemes (ChatRef cType chatId scope) uiThemes -> withUser $ \user -> case cType of
CTDirect -> do
withFastStore $ \db -> do
- ct <- getContact db vr user chatId
+ ct <- getContact db cxt user chatId
liftIO $ setContactUIThemes db user ct uiThemes
ok user
CTGroup | isNothing scope -> do
withFastStore $ \db -> do
- g <- getGroupInfo db vr user chatId
+ g <- getGroupInfo db cxt user chatId
liftIO $ setGroupUIThemes db user g uiThemes
ok user
_ -> throwCmdError "not supported"
APISetGroupCustomData groupId customData_ -> withUser $ \user -> do
withFastStore $ \db -> do
- g <- getGroupInfo db vr user groupId
+ g <- getGroupInfo db cxt user groupId
liftIO $ setGroupCustomData db user g customData_
ok user
APISetContactCustomData contactId customData_ -> withUser $ \user -> do
withFastStore $ \db -> do
- ct <- getContact db vr user contactId
+ ct <- getContact db cxt user contactId
liftIO $ setContactCustomData db user ct customData_
ok user
APIGetNtfToken -> withUser' $ \_ -> crNtfToken <$> withAgent getNtfToken
@@ -1535,7 +1535,7 @@ processChatCommand vr nm = \case
let agentConnId = AgentConnId ntfConnId
mkNtfConn user connEntity = NtfConn {user, agentConnId, agentDbQueueId = ntfDbQueueId, connEntity, expectedMsg_ = expectedMsgInfo <$> nMsgMeta}
getUserByAConnId db agentConnId
- $>>= \user -> fmap (mkNtfConn user) . eitherToMaybe <$> runExceptT (getConnectionEntity db vr user agentConnId)
+ $>>= \user -> fmap (mkNtfConn user) . eitherToMaybe <$> runExceptT (getConnectionEntity db cxt user agentConnId)
APIGetConnNtfMessages connMsgs -> withUser $ \_ -> do
msgs <- lift $ withAgent' (`getConnectionMessages` connMsgs)
let ntfMsgs = L.map receivedMsgInfo msgs
@@ -1551,7 +1551,7 @@ processChatCommand vr nm = \case
[] -> throwCmdError "no servers"
_ -> do
srvs' <- mapM aUserServer srvs
- processChatCommand vr nm $ APISetUserServers userId $ L.map (updatedServers p srvs') userServers
+ processChatCommand cxt nm $ APISetUserServers userId $ L.map (updatedServers p srvs') userServers
where
aUserServer :: AProtoServerWithAuth -> CM (AUserServer p)
aUserServer (AProtoServerWithAuth p' srv) = case testEquality p p' of
@@ -1560,7 +1560,7 @@ processChatCommand vr nm = \case
APITestProtoServer userId srv@(AProtoServerWithAuth _ server) -> withUserId userId $ \user ->
lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a nm (aUserId user) server)
TestProtoServer srv -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APITestProtoServer userId srv
+ processChatCommand cxt nm $ APITestProtoServer userId srv
APITestChatRelay userId address -> withUserId userId $ \user -> do
let failAt step e = pure $ CRChatRelayTestResult user Nothing (Just $ RelayTestFailure step e)
r <- tryAllErrors $ getShortLinkConnReq nm user address
@@ -1580,7 +1580,7 @@ processChatCommand vr nm = \case
subMode <- chatReadVar subscriptionMode
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq PQSupportOff
conn@Connection {connId = testCId} <- withFastStore $ \db ->
- createRelayTestConnection db vr user connId ConnPrepared chatV subMode
+ createRelayTestConnection db cxt user connId ConnPrepared chatV subMode
challenge <- drgRandomBytes 32
testVar <- newEmptyTMVarIO
let acId = aConnId conn
@@ -1600,9 +1600,9 @@ processChatCommand vr nm = \case
Right (Just Nothing) -> pure $ CRChatRelayTestResult user (Just relayProfile) Nothing
Right (Just (Just failure)) -> pure $ CRChatRelayTestResult user (Just relayProfile) (Just failure)
TestChatRelay address -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APITestChatRelay userId address
+ processChatCommand cxt nm $ APITestChatRelay userId address
APIAllowRelayGroup groupId -> withUser $ \user -> do
- gInfo' <- withStore $ \db -> allowRelayGroup db vr user groupId
+ gInfo' <- withStore $ \db -> allowRelayGroup db cxt user groupId
pure $ CRRelayGroupAllowed user gInfo'
GetUserChatRelays -> withUser $ \user -> do
srvs <- withFastStore (`getUserServers` user)
@@ -1615,7 +1615,7 @@ processChatCommand vr nm = \case
[] -> throwCmdError "no relays"
_ -> do
let relays' = map aUserRelay relays
- processChatCommand vr nm $ APISetUserServers userId $ L.map (updatedRelays relays') userServers
+ processChatCommand cxt nm $ APISetUserServers userId $ L.map (updatedRelays relays') userServers
where
aUserRelay :: CLINewRelay -> AUserChatRelay
aUserRelay CLINewRelay {address, name} = AUCR SDBNew $ newChatRelay (mkRelayProfile name Nothing) [""] address
@@ -1644,7 +1644,7 @@ processChatCommand vr nm = \case
SetServerOperators operatorsRoles -> do
ops <- serverOperators <$> withFastStore getServerOperators
ops' <- mapM (updateOp ops) operatorsRoles
- processChatCommand vr nm $ APISetServerOperators ops'
+ processChatCommand cxt nm $ APISetServerOperators ops'
where
updateOp :: [ServerOperator] -> ServerOperatorRoles -> CM ServerOperator
updateOp ops r =
@@ -1709,14 +1709,14 @@ processChatCommand vr nm = \case
expireChat user globalTTL = do
currentTs <- liftIO getCurrentTime
case cType of
- CTDirect -> expireContactChatItems user vr globalTTL chatId
+ CTDirect -> expireContactChatItems user cxt globalTTL chatId
CTGroup | isNothing scope ->
let createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs
- in expireGroupChatItems user vr globalTTL createdAtCutoff chatId
+ in expireGroupChatItems user cxt globalTTL createdAtCutoff chatId
_ -> throwCmdError "not supported"
SetChatTTL chatName newTTL -> withUser' $ \user@User {userId} -> do
chatRef <- getChatRef user chatName
- processChatCommand vr nm $ APISetChatTTL userId chatRef newTTL
+ processChatCommand cxt nm $ APISetChatTTL userId chatRef newTTL
GetChatTTL chatName -> withUser' $ \user -> do
-- TODO [knocking] support scope in CLI apis
ChatRef cType chatId _ <- getChatRef user chatName
@@ -1736,18 +1736,18 @@ processChatCommand vr nm = \case
lift $ setChatItemsExpiration user newTTL ttlCount
ok user
SetChatItemTTL newTTL_ -> withUser' $ \User {userId} -> do
- processChatCommand vr nm $ APISetChatItemTTL userId newTTL_
+ processChatCommand cxt nm $ APISetChatItemTTL userId newTTL_
APIGetChatItemTTL userId -> withUserId' userId $ \user -> do
ttl <- withFastStore' (`getChatItemTTL` user)
pure $ CRChatItemTTL user (Just ttl)
GetChatItemTTL -> withUser' $ \User {userId} -> do
- processChatCommand vr nm $ APIGetChatItemTTL userId
+ processChatCommand cxt nm $ APIGetChatItemTTL userId
APISetNetworkConfig cfg -> withUser' $ \_ -> withAgent (`setNetworkConfig` cfg) >> ok_
APIGetNetworkConfig -> withUser' $ \_ ->
CRNetworkConfig <$> lift getNetworkConfig
SetNetworkConfig simpleNetCfg -> do
cfg <- (`updateNetworkConfig` simpleNetCfg) <$> lift getNetworkConfig
- void . processChatCommand vr nm $ APISetNetworkConfig cfg
+ void . processChatCommand cxt nm $ APISetNetworkConfig cfg
pure $ CRNetworkConfig cfg
APISetNetworkInfo info -> lift (withAgent' (`setUserNetworkInfo` info)) >> ok_
ReconnectAllServers -> withUser' $ \_ -> lift (withAgent' reconnectAllServers) >> ok_
@@ -1757,7 +1757,7 @@ processChatCommand vr nm = \case
APISetChatSettings (ChatRef cType chatId scope) chatSettings -> withUser $ \user -> case cType of
CTDirect -> do
ct <- withFastStore $ \db -> do
- ct <- getContact db vr user chatId
+ ct <- getContact db cxt user chatId
liftIO $ updateContactSettings db user chatId chatSettings
pure ct
forM_ (contactConnId ct) $ \connId ->
@@ -1765,7 +1765,7 @@ processChatCommand vr nm = \case
ok user
CTGroup | isNothing scope -> do
ms <- withFastStore $ \db -> do
- gInfo <- getGroupInfo db vr user chatId
+ gInfo <- getGroupInfo db cxt user chatId
ms <- liftIO $ getMembers db gInfo
liftIO $ updateGroupSettings db user chatId chatSettings
pure ms
@@ -1774,19 +1774,19 @@ processChatCommand vr nm = \case
ok user
where
getMembers db gInfo
- | useRelays' gInfo = getGroupRelayMembers db vr user gInfo
- | otherwise = getGroupMembers db vr user gInfo
+ | useRelays' gInfo = getGroupRelayMembers db cxt user gInfo
+ | otherwise = getGroupMembers db cxt user gInfo
_ -> throwCmdError "not supported"
APISetMemberSettings gId gMemberId settings -> withUser $ \user -> do
m <- withFastStore $ \db -> do
liftIO $ updateGroupMemberSettings db user gId gMemberId settings
- getGroupMember db vr user gId gMemberId
+ getGroupMember db cxt user gId gMemberId
let ntfOn = not (memberBlocked m)
toggleNtf m ntfOn
ok user
APIContactInfo contactId -> withUser $ \user@User {userId} -> do
-- [incognito] print user's incognito profile for this contact
- ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId
+ ct@Contact {activeConn} <- withFastStore $ \db -> getContact db cxt user contactId
incognitoProfile <- case activeConn of
Nothing -> pure Nothing
Just Connection {customUserProfileId} ->
@@ -1794,14 +1794,14 @@ processChatCommand vr nm = \case
connectionStats <- mapM (withAgent . flip getConnectionServers) (contactConnId ct)
pure $ CRContactInfo user ct connectionStats (fmap fromLocalProfile incognitoProfile)
APIContactQueueInfo contactId -> withUser $ \user -> do
- ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId
+ ct@Contact {activeConn} <- withFastStore $ \db -> getContact db cxt user contactId
case activeConn of
Just conn -> getConnQueueInfo user conn
Nothing -> throwChatError $ CEContactNotActive ct
APIGroupInfo gId -> withUser $ \user ->
- CRGroupInfo user <$> withFastStore (\db -> getGroupInfo db vr user gId)
+ CRGroupInfo user <$> withFastStore (\db -> getGroupInfo db cxt user gId)
APIGetUpdatedGroupLinkData groupId -> withUser $ \user -> do
- gInfo@GroupInfo {groupProfile = p, groupSummary = GroupSummary {publicMemberCount = localCount}} <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo@GroupInfo {groupProfile = p, groupSummary = GroupSummary {publicMemberCount = localCount}} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
case p of
GroupProfile {publicGroup = Just PublicGroupProfile {groupLink = sLnk}} | useRelays' gInfo -> do
(_, cData@(ContactLinkData _ UserContactData {relays = currentRelayLinks})) <- getShortLinkConnReq' nm user sLnk
@@ -1815,44 +1815,44 @@ processChatCommand vr nm = \case
pure $ CRGroupInfo user gInfo'
_ -> throwCmdError "group link data not available"
APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do
- (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
+ (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user gId <*> getGroupMember db cxt user gId gMemberId
connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m)
pure $ CRGroupMemberInfo user g m connectionStats
APIGroupMemberQueueInfo gId gMemberId -> withUser $ \user -> do
- GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId
+ GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db cxt user gId gMemberId
case activeConn of
Just conn -> getConnQueueInfo user conn
Nothing -> throwChatError CEGroupMemberNotActive
APISwitchContact contactId -> withUser $ \user -> do
- ct <- withFastStore $ \db -> getContact db vr user contactId
+ ct <- withFastStore $ \db -> getContact db cxt user contactId
case contactConnId ct of
Just connId -> do
connectionStats <- withAgent $ \a -> switchConnectionAsync a "" connId
pure $ CRContactSwitchStarted user ct connectionStats
Nothing -> throwChatError $ CEContactNotActive ct
APISwitchGroupMember gId gMemberId -> withUser $ \user -> do
- (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
+ (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user gId <*> getGroupMember db cxt user gId gMemberId
case memberConnId m of
Just connId -> do
connectionStats <- withAgent (\a -> switchConnectionAsync a "" connId)
pure $ CRGroupMemberSwitchStarted user g m connectionStats
_ -> throwChatError CEGroupMemberNotActive
APIAbortSwitchContact contactId -> withUser $ \user -> do
- ct <- withFastStore $ \db -> getContact db vr user contactId
+ ct <- withFastStore $ \db -> getContact db cxt user contactId
case contactConnId ct of
Just connId -> do
connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId
pure $ CRContactSwitchAborted user ct connectionStats
Nothing -> throwChatError $ CEContactNotActive ct
APIAbortSwitchGroupMember gId gMemberId -> withUser $ \user -> do
- (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
+ (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user gId <*> getGroupMember db cxt user gId gMemberId
case memberConnId m of
Just connId -> do
connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId
pure $ CRGroupMemberSwitchAborted user g m connectionStats
_ -> throwChatError CEGroupMemberNotActive
APISyncContactRatchet contactId force -> withUser $ \user -> withContactLock "syncContactRatchet" contactId $ do
- ct <- withFastStore $ \db -> getContact db vr user contactId
+ ct <- withFastStore $ \db -> getContact db cxt user contactId
case contactConn ct of
Just conn@Connection {pqSupport} -> do
cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (aConnId conn) pqSupport force
@@ -1860,7 +1860,7 @@ processChatCommand vr nm = \case
pure $ CRContactRatchetSyncStarted user ct cStats
Nothing -> throwChatError $ CEContactNotActive ct
APISyncGroupMemberRatchet gId gMemberId force -> withUser $ \user -> withGroupLock "syncGroupMemberRatchet" gId $ do
- (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
+ (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user gId <*> getGroupMember db cxt user gId gMemberId
case memberConnId m of
Just connId -> do
cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId PQSupportOff force
@@ -1869,7 +1869,7 @@ processChatCommand vr nm = \case
pure $ CRGroupMemberRatchetSyncStarted user g' m' cStats
_ -> throwChatError CEGroupMemberNotActive
APIGetContactCode contactId -> withUser $ \user -> do
- ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId
+ ct@Contact {activeConn} <- withFastStore $ \db -> getContact db cxt user contactId
case activeConn of
Just conn@Connection {connId} -> do
code <- getConnectionCode $ aConnId conn
@@ -1883,7 +1883,7 @@ processChatCommand vr nm = \case
pure $ CRContactCode user ct' code
Nothing -> throwChatError $ CEContactNotActive ct
APIGetGroupMemberCode gId gMemberId -> withUser $ \user -> do
- (g, m@GroupMember {activeConn}) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
+ (g, m@GroupMember {activeConn}) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user gId <*> getGroupMember db cxt user gId gMemberId
case activeConn of
Just conn@Connection {connId} -> do
code <- getConnectionCode $ aConnId conn
@@ -1897,24 +1897,24 @@ processChatCommand vr nm = \case
pure $ CRGroupMemberCode user g m' code
_ -> throwChatError CEGroupMemberNotActive
APIVerifyContact contactId code -> withUser $ \user -> do
- ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId
+ ct@Contact {activeConn} <- withFastStore $ \db -> getContact db cxt user contactId
case activeConn of
Just conn -> verifyConnectionCode user conn code
Nothing -> throwChatError $ CEContactNotActive ct
APIVerifyGroupMember gId gMemberId code -> withUser $ \user -> do
- GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId
+ GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db cxt user gId gMemberId
case activeConn of
Just conn -> verifyConnectionCode user conn code
_ -> throwChatError CEGroupMemberNotActive
APIEnableContact contactId -> withUser $ \user -> do
- ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId
+ ct@Contact {activeConn} <- withFastStore $ \db -> getContact db cxt user contactId
case activeConn of
Just conn -> do
withFastStore' $ \db -> setAuthErrCounter db user conn 0
ok user
Nothing -> throwChatError $ CEContactNotActive ct
APIEnableGroupMember gId gMemberId -> withUser $ \user -> do
- GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId
+ GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db cxt user gId gMemberId
case activeConn of
Just conn -> do
withFastStore' $ \db -> setAuthErrCounter db user conn 0
@@ -1924,16 +1924,16 @@ processChatCommand vr nm = \case
SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_})
SetShowMemberMessages gName mName showMessages -> withUser $ \user -> do
(gId, mId) <- getGroupAndMemberId user gName mName
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
- m <- withFastStore $ \db -> getGroupMember db vr user gId mId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user gId
+ m <- withFastStore $ \db -> getGroupMember db cxt user gId mId
let GroupInfo {membership = GroupMember {memberRole = membershipRole}} = gInfo
when (membershipRole >= GRModerator) $ throwChatError $ CECantBlockMemberForSelf gInfo m showMessages
let settings = (memberSettings m) {showMessages}
- processChatCommand vr nm $ APISetMemberSettings gId mId settings
+ processChatCommand cxt nm $ APISetMemberSettings gId mId settings
ContactInfo cName -> withContactName cName APIContactInfo
ShowGroupInfo gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIGroupInfo groupId
+ processChatCommand cxt nm $ APIGroupInfo groupId
GroupMemberInfo gName mName -> withMemberName gName mName APIGroupMemberInfo
ContactQueueInfo cName -> withContactName cName APIContactQueueInfo
GroupMemberQueueInfo gName mName -> withMemberName gName mName APIGroupMemberQueueInfo
@@ -1963,7 +1963,7 @@ processChatCommand vr nm = \case
conn <- withFastStore' $ \db -> createDirectConnection db user connId ccLink' Nothing ConnNew incognitoProfile subMode initialChatVersion PQSupportOn
pure $ CRInvitation user ccLink' conn
AddContact incognito -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APIAddContact userId incognito
+ processChatCommand cxt nm $ APIAddContact userId incognito
APISetConnectionIncognito connId incognito -> withUser $ \user@User {userId} -> do
conn <- withFastStore $ \db -> getPendingContactConnection db userId connId
let PendingContactConnection {pccConnStatus, customUserProfileId} = conn
@@ -2020,7 +2020,7 @@ processChatCommand vr nm = \case
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences
groupProfile = businessGroupProfile profile groupPreferences
gVar <- asks random
- (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user groupProfile True ccLink welcomeSharedMsgId False GRMember Nothing
+ (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user groupProfile True ccLink welcomeSharedMsgId False GRMember Nothing
hostMember <- maybe (throwCmdError "no host member") pure hostMember_
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart)
let cd = CDGroupRcv gInfo Nothing hostMember
@@ -2033,7 +2033,7 @@ processChatCommand vr nm = \case
_ -> Chat cInfo [] emptyChatStats
pure $ CRNewPreparedChat user $ AChat SCTGroup chat
ACCL _ (CCLink cReq _) -> do
- ct <- withStore $ \db -> createPreparedContact db vr user profile accLink welcomeSharedMsgId
+ ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId
void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing (Just epochStart)
let cd = CDDirectRcv ct
createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing
@@ -2052,7 +2052,7 @@ processChatCommand vr nm = \case
let useRelays = not direct
subRole <- if useRelays then asks $ channelSubscriberRole . config else pure GRMember
gVar <- asks random
- (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user gp False ccLink welcomeSharedMsgId useRelays subRole publicMemberCount_
+ (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user gp False ccLink welcomeSharedMsgId useRelays subRole publicMemberCount_
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart)
let cd = maybe (CDChannelRcv gInfo Nothing) (CDGroupRcv gInfo Nothing) hostMember_
cInfo = GroupChat gInfo Nothing
@@ -2063,40 +2063,40 @@ processChatCommand vr nm = \case
_ -> Chat cInfo [] emptyChatStats
pure $ CRNewPreparedChat user $ AChat SCTGroup chat
APIChangePreparedContactUser contactId newUserId -> withUser $ \user -> do
- ct@Contact {preparedContact} <- withFastStore $ \db -> getContact db vr user contactId
+ ct@Contact {preparedContact} <- withFastStore $ \db -> getContact db cxt user contactId
when (isNothing preparedContact) $ throwCmdError "contact doesn't have link to connect"
when (isJust $ contactConn ct) $ throwCmdError "contact already has connection"
newUser <- privateGetUser newUserId
- ct' <- withFastStore $ \db -> updatePreparedContactUser db vr user ct newUser
+ ct' <- withFastStore $ \db -> updatePreparedContactUser db cxt user ct newUser
-- create changed feature items (new user may have different preferences)
lift $ createContactChangedFeatureItems user ct ct'
pure $ CRContactUserChanged user ct newUser ct'
APIChangePreparedGroupUser groupId newUserId -> withUser $ \user -> do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
when (isNothing $ preparedGroup gInfo) $ throwCmdError "group doesn't have link to connect"
hostMember_ <-
if useRelays' gInfo
then pure Nothing
else do
- hostMember <- withFastStore $ \db -> getHostMember db vr user groupId
+ hostMember <- withFastStore $ \db -> getHostMember db cxt user groupId
when (isJust $ memberConn hostMember) $ throwCmdError "host member already has connection"
pure $ Just hostMember
newUser <- privateGetUser newUserId
- gInfo' <- withFastStore $ \db -> updatePreparedGroupUser db vr user gInfo hostMember_ newUser
+ gInfo' <- withFastStore $ \db -> updatePreparedGroupUser db cxt user gInfo hostMember_ newUser
pure $ CRGroupUserChanged user gInfo newUser gInfo'
APIConnectPreparedContact contactId incognito msgContent_ -> withUser $ \user -> do
- ct@Contact {preparedContact} <- withFastStore $ \db -> getContact db vr user contactId
+ ct@Contact {preparedContact} <- withFastStore $ \db -> getContact db cxt user contactId
case preparedContact of
Nothing -> throwCmdError "contact doesn't have link to connect"
Just PreparedContact {connLinkToConnect = ACCL SCMInvitation ccLink} -> do
(_, customUserProfile) <- connectViaInvitation user incognito ccLink (Just contactId) `catchAllErrors` \e -> do
-- get updated contact, in case connection was started - in UI it would lock ability to change
-- user or incognito profile for contact, in case server received request while client got network error
- ct' <- withFastStore $ \db -> getContact db vr user contactId
+ ct' <- withFastStore $ \db -> getContact db cxt user contactId
toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
throwError e
-- get updated contact with connection
- ct' <- withFastStore $ \db -> getContact db vr user contactId
+ ct' <- withFastStore $ \db -> getContact db cxt user contactId
-- create changed feature items (connecting incognito sends default preferences, instead of user preferences)
lift . when incognito $ createContactChangedFeatureItems user ct ct'
forM_ msgContent_ $ \mc -> do
@@ -2115,13 +2115,13 @@ processChatCommand vr nm = \case
r <- connectViaContact user (Just $ PCEContact ct) incognito ccLink welcomeSharedMsgId msg_ `catchAllErrors` \e -> do
-- get updated contact, in case connection was started - in UI it would lock ability to change
-- user or incognito profile for contact, in case server received request while client got network error
- ct' <- withFastStore $ \db -> getContact db vr user contactId
+ ct' <- withFastStore $ \db -> getContact db cxt user contactId
toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
throwError e
case r of
CVRSentInvitation _conn customUserProfile -> do
-- get updated contact with connection
- ct' <- withFastStore $ \db -> getContact db vr user contactId
+ ct' <- withFastStore $ \db -> getContact db cxt user contactId
-- create changed feature items (connecting incognito sends default preferences, instead of user preferences)
lift . when incognito $ createContactChangedFeatureItems user ct ct'
forM_ msg_ $ \(sharedMsgId, mc) -> do
@@ -2130,7 +2130,7 @@ processChatCommand vr nm = \case
pure $ CRStartedConnectionToContact user ct' customUserProfile
CVRConnectedContact ct' -> pure $ CRContactAlreadyExists user ct'
APIConnectPreparedGroup {groupId, incognito, ownerContact, msgContent_} -> withUser $ \user -> do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
case gInfo of
GroupInfo {preparedGroup = Nothing} -> throwCmdError "group doesn't have link to connect"
GroupInfo {useRelays = BoolDef True, preparedGroup = Just PreparedGroup {connLinkToConnect}} -> do
@@ -2153,14 +2153,14 @@ processChatCommand vr nm = \case
gVar <- asks random
(_, memberPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar
gInfo' <- withFastStore $ \db -> do
- gInfo' <- updatePreparedRelayedGroup db vr user gInfo mainCReq cReqHash incognitoProfile rootKey memberPrivKey publicMemberCount_
+ gInfo' <- updatePreparedRelayedGroup db cxt user gInfo mainCReq cReqHash incognitoProfile rootKey memberPrivKey publicMemberCount_
-- Pre-emptively create owner members with trusted keys from link data
forM_ owners $ \OwnerAuth {ownerId, ownerKey} -> do
let ctId_ = case ownerContact of
Just GroupOwnerContact {contactId, memberId}
| memberId == MemberId ownerId -> Just contactId
_ -> Nothing
- void $ createLinkOwnerMember db vr user gInfo' ctId_ (MemberId ownerId) ownerKey
+ void $ createLinkOwnerMember db cxt user gInfo' ctId_ (MemberId ownerId) ownerKey
pure gInfo'
rs <- withGroupLock "connectPreparedGroup" groupId $
mapConcurrently (connectToRelay user gInfo') relays
@@ -2178,7 +2178,7 @@ processChatCommand vr nm = \case
else do
gInfo'' <- withFastStore $ \db -> do
liftIO $ setPreparedGroupStartedConnection db groupId
- getGroupInfo db vr user groupId
+ getGroupInfo db cxt user groupId
-- Async retry failed relays with temporary errors
let retryable = [(l, m) | r@(l, m, _) <- failed, isTempErr r]
void $ mapConcurrently (uncurry $ retryRelayConnectionAsync gInfo') retryable
@@ -2198,7 +2198,7 @@ processChatCommand vr nm = \case
newConnIds <- getAgentConnShortLinkAsync user CFGetRelayDataJoin Nothing relayLink
withStore' $ \db -> createRelayMemberConnectionAsync db user gInfo' relayMember relayLink newConnIds subMode
GroupInfo {preparedGroup = Just PreparedGroup {connLinkToConnect, welcomeSharedMsgId, requestSharedMsgId}} -> do
- hostMember <- withFastStore $ \db -> getHostMember db vr user groupId
+ hostMember <- withFastStore $ \db -> getHostMember db cxt user groupId
msg_ <- forM msgContent_ $ \mc -> case requestSharedMsgId of
Just smId -> pure (smId, mc)
Nothing -> do
@@ -2208,7 +2208,7 @@ processChatCommand vr nm = \case
r <- connectViaContact user (Just $ PCEGroup gInfo hostMember) incognito connLinkToConnect welcomeSharedMsgId msg_ `catchAllErrors` \e -> do
-- get updated group info, in case connection was started (connLinkPreparedConnection) - in UI it would lock ability to change
-- user or incognito profile for group or business chat, in case server received request while client got network error
- gInfo' <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo' <- withFastStore $ \db -> getGroupInfo db cxt user groupId
toView $ CEvtChatInfoUpdated user (AChatInfo SCTGroup $ GroupChat gInfo' Nothing)
throwError e
case r of
@@ -2216,7 +2216,7 @@ processChatCommand vr nm = \case
-- get updated group info (connLinkStartedConnection and incognito membership)
gInfo' <- withFastStore $ \db -> do
liftIO $ setPreparedGroupStartedConnection db groupId
- getGroupInfo db vr user groupId
+ getGroupInfo db cxt user groupId
forM_ msg_ $ \(sharedMsgId, mc) -> do
ci <- createChatItem user (CDGroupSnd gInfo' Nothing) False (CISndMsgContent mc) (Just sharedMsgId) Nothing
toView $ CEvtNewChatItems user [ci]
@@ -2242,7 +2242,7 @@ processChatCommand vr nm = \case
connectWithPlan user incognito ccLink plan
Connect _ Nothing -> throwChatError CEInvalidConnReq
APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do
- ct@Contact {profile = LocalProfile {contactLink}} <- withFastStore $ \db -> getContact db vr user contactId
+ ct@Contact {profile = LocalProfile {contactLink}} <- withFastStore $ \db -> getContact db cxt user contactId
ccLink <- case contactLink of
Just (CLFull cReq) -> pure $ CCLink cReq Nothing
Just (CLShort sLnk) -> do
@@ -2252,7 +2252,7 @@ processChatCommand vr nm = \case
connectContactViaAddress user incognito ct ccLink `catchAllErrors` \e -> do
-- get updated contact, in case connection was started - in UI it would lock ability to change incognito choice
-- on next connection attempt, in case server received request while client got network error
- ct' <- withFastStore $ \db -> getContact db vr user contactId
+ ct' <- withFastStore $ \db -> getContact db cxt user contactId
toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
throwError e
ConnectSimplex incognito -> withUser $ \user -> do
@@ -2261,9 +2261,9 @@ processChatCommand vr nm = \case
DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId Nothing) cdm
ClearContact cName -> withContactName cName $ \chatId -> APIClearChat $ ChatRef CTDirect chatId Nothing
APIListContacts userId -> withUserId userId $ \user ->
- CRContactsList user <$> withFastStore' (\db -> getUserContacts db vr user)
+ CRContactsList user <$> withFastStore' (\db -> getUserContacts db cxt user)
ListContacts -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APIListContacts userId
+ processChatCommand cxt nm $ APIListContacts userId
APICreateMyAddress userId -> withUserId userId $ \user@User {userChatRelay} -> do
withFastStore' (\db -> runExceptT $ getUserAddress db user) >>= \case
Left SEUserContactLinkNotFound -> pure ()
@@ -2281,9 +2281,9 @@ processChatCommand vr nm = \case
withFastStore $ \db -> createUserContactLink db user connId ccLink'' subMode
pure $ CRUserContactLinkCreated user ccLink''
CreateMyAddress -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APICreateMyAddress userId
+ processChatCommand cxt nm $ APICreateMyAddress userId
APIDeleteMyAddress userId -> withUserId userId $ \user@User {profile = p} -> do
- conn <- withFastStore $ \db -> getUserAddressConnection db vr user
+ conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
withChatLock "deleteMyAddress" $ do
deleteAgentConnectionAsync $ aConnId conn
withFastStore' (`deleteUserAddress` user)
@@ -2294,11 +2294,11 @@ processChatCommand vr nm = \case
_ -> user
pure $ CRUserContactLinkDeleted user'
DeleteMyAddress -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APIDeleteMyAddress userId
+ processChatCommand cxt nm $ APIDeleteMyAddress userId
APIShowMyAddress userId -> withUserId' userId $ \user ->
CRUserContactLink user <$> withFastStore (`getUserAddress` user)
ShowMyAddress -> withUser' $ \User {userId} ->
- processChatCommand vr nm $ APIShowMyAddress userId
+ processChatCommand cxt nm $ APIShowMyAddress userId
APIAddMyAddressShortLink userId -> withUserId' userId $ \user ->
CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData user)
APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do
@@ -2310,7 +2310,7 @@ processChatCommand vr nm = \case
let p' = (fromLocalProfile p :: Profile) {contactLink = Just $ profileContactLink ucl}
updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl
SetProfileAddress onOff -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APISetProfileAddress userId onOff
+ processChatCommand cxt nm $ APISetProfileAddress userId onOff
APISetAddressSettings userId settings@AddressSettings {businessAddress, autoAccept} -> withUserId userId $ \user -> do
ucl@UserContactLink {userContactLinkId, shortLinkDataSet, addressSettings} <- withFastStore (`getUserAddress` user)
forM_ autoAccept $ \AutoAccept {acceptIncognito} -> do
@@ -2324,43 +2324,43 @@ processChatCommand vr nm = \case
withFastStore' $ \db -> updateUserAddressSettings db userContactLinkId settings
pure $ CRUserContactLinkUpdated user ucl''
SetAddressSettings settings -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APISetAddressSettings userId settings
+ processChatCommand cxt nm $ APISetAddressSettings userId settings
AcceptContact incognito cName -> withUser $ \User {userId} -> do
connReqId <- withFastStore $ \db -> getContactRequestIdByName db userId cName
- processChatCommand vr nm $ APIAcceptContact incognito connReqId
+ processChatCommand cxt nm $ APIAcceptContact incognito connReqId
RejectContact cName -> withUser $ \User {userId} -> do
connReqId <- withFastStore $ \db -> getContactRequestIdByName db userId cName
- processChatCommand vr nm $ APIRejectContact connReqId
+ processChatCommand cxt nm $ APIRejectContact connReqId
ForwardMessage toChatName fromContactName forwardedMsg -> withUser $ \user -> do
contactId <- withFastStore $ \db -> getContactIdByName db user fromContactName
forwardedItemId <- withFastStore $ \db -> getDirectChatItemIdByText' db user contactId forwardedMsg
toChatRef <- getChatRef user toChatName
asGroup <- getSendAsGroup user toChatRef
- processChatCommand vr nm $ APIForwardChatItems toChatRef asGroup (ChatRef CTDirect contactId Nothing) (forwardedItemId :| []) Nothing
+ processChatCommand cxt nm $ APIForwardChatItems toChatRef asGroup (ChatRef CTDirect contactId Nothing) (forwardedItemId :| []) Nothing
ForwardGroupMessage toChatName fromGroupName fromMemberName_ forwardedMsg -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user fromGroupName
forwardedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user groupId fromMemberName_ forwardedMsg
toChatRef <- getChatRef user toChatName
asGroup <- getSendAsGroup user toChatRef
- processChatCommand vr nm $ APIForwardChatItems toChatRef asGroup (ChatRef CTGroup groupId Nothing) (forwardedItemId :| []) Nothing
+ processChatCommand cxt nm $ APIForwardChatItems toChatRef asGroup (ChatRef CTGroup groupId Nothing) (forwardedItemId :| []) Nothing
ForwardLocalMessage toChatName forwardedMsg -> withUser $ \user -> do
folderId <- withFastStore (`getUserNoteFolderId` user)
forwardedItemId <- withFastStore $ \db -> getLocalChatItemIdByText' db user folderId forwardedMsg
toChatRef <- getChatRef user toChatName
asGroup <- getSendAsGroup user toChatRef
- processChatCommand vr nm $ APIForwardChatItems toChatRef asGroup (ChatRef CTLocal folderId Nothing) (forwardedItemId :| []) Nothing
+ processChatCommand cxt nm $ APIForwardChatItems toChatRef asGroup (ChatRef CTLocal folderId Nothing) (forwardedItemId :| []) Nothing
SharePublicGroup shareGroupName toChatName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user shareGroupName
toChatRef <- getChatRef user toChatName
sendRef <- case toChatRef of
ChatRef CTDirect ctId _ -> pure $ SRDirect ctId
ChatRef CTGroup gId scope_ -> do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user gId
pure $ SRGroup gId scope_ (useRelays' gInfo)
_ -> throwCmdError "unsupported share target"
- processChatCommand vr nm (APIShareChatMsgContent (ChatRef CTGroup groupId Nothing) sendRef) >>= \case
+ processChatCommand cxt nm (APIShareChatMsgContent (ChatRef CTGroup groupId Nothing) sendRef) >>= \case
CRChatMsgContent _ mc ->
- processChatCommand vr nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
+ processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
r -> pure r
SendMessage sendName msg -> withUser $ \user -> do
let mc = MCText msg
@@ -2369,57 +2369,57 @@ processChatCommand vr nm = \case
withFastStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case
Right ctId -> do
let sendRef = SRDirect ctId
- processChatCommand vr nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
+ processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
Left _ ->
- withFastStore' (\db -> runExceptT $ getActiveMembersByName db vr user name) >>= \case
+ withFastStore' (\db -> runExceptT $ getActiveMembersByName db cxt user name) >>= \case
Right [(gInfo, member)] -> do
let GroupInfo {localDisplayName = gName} = gInfo
GroupMember {localDisplayName = mName} = member
- processChatCommand vr nm $ SendMemberContactMessage gName mName msg
+ processChatCommand cxt nm $ SendMemberContactMessage gName mName msg
Right (suspectedMember : _) ->
throwChatError $ CEContactNotFound name (Just suspectedMember)
_ ->
throwChatError $ CEContactNotFound name Nothing
SNGroup name scope_ -> do
(gInfo, cScope_, mentions) <- withFastStore $ \db -> do
- gInfo <- getGroupInfoByName db vr user name
+ gInfo <- getGroupInfoByName db cxt user name
let gId = groupId' gInfo
cScope_ <-
forM scope_ $ \(GSNMemberSupport mName_) ->
GCSMemberSupport <$> mapM (getGroupMemberIdByName db user gId) mName_
(gInfo, cScope_,) <$> liftIO (getMessageMentions db user gId msg)
let sendRef = SRGroup (groupId' gInfo) cScope_ (sendAsGroup' gInfo cScope_)
- processChatCommand vr nm $ APISendMessages sendRef False Nothing [ComposedMessage Nothing Nothing mc mentions]
+ processChatCommand cxt nm $ APISendMessages sendRef False Nothing [ComposedMessage Nothing Nothing mc mentions]
SNLocal -> do
folderId <- withFastStore (`getUserNoteFolderId` user)
- processChatCommand vr nm $ APICreateChatItems folderId [composedMessage Nothing mc]
+ processChatCommand cxt nm $ APICreateChatItems folderId [composedMessage Nothing mc]
SendMemberContactMessage gName mName msg -> withUser $ \user -> do
(gId, mId) <- getGroupAndMemberId user gName mName
- m <- withFastStore $ \db -> getGroupMember db vr user gId mId
+ m <- withFastStore $ \db -> getGroupMember db cxt user gId mId
let mc = MCText msg
case memberContactId m of
Nothing -> do
- g <- withFastStore $ \db -> getGroupInfo db vr user gId
+ g <- withFastStore $ \db -> getGroupInfo db cxt user gId
unless (groupFeatureUserAllowed SGFDirectMessages g) $ throwCmdError "direct messages not allowed"
toView $ CEvtNoMemberContactCreating user g m
- processChatCommand vr nm (APICreateMemberContact gId mId) >>= \case
+ processChatCommand cxt nm (APICreateMemberContact gId mId) >>= \case
CRNewMemberContact _ ct@Contact {contactId} _ _ -> do
toViewTE $ TENewMemberContact user ct g m
- processChatCommand vr nm $ APISendMemberContactInvitation contactId (Just mc)
+ processChatCommand cxt nm $ APISendMemberContactInvitation contactId (Just mc)
cr -> pure cr
Just ctId -> do
let sendRef = SRDirect ctId
- processChatCommand vr nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
+ processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
AcceptMemberContact cName -> withUser $ \user -> do
contactId <- withFastStore $ \db -> getContactIdByName db user cName
- processChatCommand vr nm $ APIAcceptMemberContact contactId
+ processChatCommand cxt nm $ APIAcceptMemberContact contactId
SendLiveMessage chatName msg -> withUser $ \user -> do
(chatRef, mentions) <- getChatRefAndMentions user chatName msg
withSendRef user chatRef $ \sendRef -> do
let mc = MCText msg
- processChatCommand vr nm $ APISendMessages sendRef True Nothing [ComposedMessage Nothing Nothing mc mentions]
+ processChatCommand cxt nm $ APISendMessages sendRef True Nothing [ComposedMessage Nothing Nothing mc mentions]
SendMessageBroadcast mc -> withUser $ \user -> do
- contacts <- withFastStore' $ \db -> getUserContacts db vr user
+ contacts <- withFastStore' $ \db -> getUserContacts db cxt user
withChatLock "sendMessageBroadcast" $ do
let ctConns_ = L.nonEmpty $ foldr addContactConn [] contacts
case ctConns_ of
@@ -2462,28 +2462,28 @@ processChatCommand vr nm = \case
contactId <- withFastStore $ \db -> getContactIdByName db user cName
quotedItemId <- withFastStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
let mc = MCText msg
- processChatCommand vr nm $ APISendMessages (SRDirect contactId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc M.empty]
+ processChatCommand cxt nm $ APISendMessages (SRDirect contactId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc M.empty]
DeleteMessage chatName deletedMsg -> withUser $ \user -> do
chatRef <- getChatRef user chatName
deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg
- processChatCommand vr nm $ APIDeleteChatItem chatRef (deletedItemId :| []) CIDMBroadcast
+ processChatCommand cxt nm $ APIDeleteChatItem chatRef (deletedItemId :| []) CIDMBroadcast
DeleteMemberMessage gName mName deletedMsg -> withUser $ \user -> do
gId <- withFastStore $ \db -> getGroupIdByName db user gName
deletedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user gId (Just mName) deletedMsg
- processChatCommand vr nm $ APIDeleteMemberChatItem gId (deletedItemId :| [])
+ processChatCommand cxt nm $ APIDeleteMemberChatItem gId (deletedItemId :| [])
EditMessage chatName editedMsg msg -> withUser $ \user -> do
(chatRef, mentions) <- getChatRefAndMentions user chatName msg
editedItemId <- getSentChatItemIdByText user chatRef editedMsg
let mc = MCText msg
- processChatCommand vr nm $ APIUpdateChatItem chatRef editedItemId False $ UpdatedMessage mc mentions
+ processChatCommand cxt nm $ APIUpdateChatItem chatRef editedItemId False $ UpdatedMessage mc mentions
UpdateLiveMessage chatName chatItemId live msg -> withUser $ \user -> do
(chatRef, mentions) <- getChatRefAndMentions user chatName msg
let mc = MCText msg
- processChatCommand vr nm $ APIUpdateChatItem chatRef chatItemId live $ UpdatedMessage mc mentions
+ processChatCommand cxt nm $ APIUpdateChatItem chatRef chatItemId live $ UpdatedMessage mc mentions
ReactToMessage add reaction chatName msg -> withUser $ \user -> do
chatRef <- getChatRef user chatName
chatItemId <- getChatItemIdByText user chatRef msg
- processChatCommand vr nm $ APIChatItemReaction chatRef chatItemId add reaction
+ processChatCommand cxt nm $ APIChatItemReaction chatRef chatItemId add reaction
APINewGroup userId incognito gProfile -> withUserId userId $ \user -> do
g <- asks random
memberId <- liftIO $ MemberId <$> encodedRandomBytes g 12
@@ -2491,7 +2491,7 @@ processChatCommand vr nm = \case
createNewGroupItems user gInfo
pure $ CRGroupCreated user gInfo
NewGroup incognito gProfile -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APINewGroup userId incognito gProfile
+ processChatCommand cxt nm $ APINewGroup userId incognito gProfile
APINewPublicGroup userId incognito relayIds groupProfile -> withUserId userId $ \user -> do
(gProfile', memberId, groupKeys, setupLink) <- prepareGroupLink user
gInfo <- newGroup user incognito gProfile' True memberId (Just groupKeys) (Just 1)
@@ -2551,16 +2551,16 @@ processChatCommand vr nm = \case
pure (gLink, results)
pure (groupProfile', memberId, groupKeys, setupLink)
NewPublicGroup incognito relayIds gProfile -> withUser $ \User {userId} ->
- processChatCommand vr nm $ APINewPublicGroup userId incognito relayIds gProfile
+ processChatCommand cxt nm $ APINewPublicGroup userId incognito relayIds gProfile
APIGetGroupRelays groupId -> withUser $ \user -> do
(gInfo, relays) <- withFastStore $ \db -> do
- gInfo <- getGroupInfo db vr user groupId
+ gInfo <- getGroupInfo db cxt user groupId
relays <- liftIO $ getGroupRelays db gInfo
pure (gInfo, relays)
pure $ CRGroupRelays user gInfo relays
APIAddGroupRelays groupId relayIds -> withUser $ \user -> withGroupLock "addGroupRelays" groupId $ do
(gInfo, existingRelays) <- withFastStore $ \db -> do
- gi <- getGroupInfo db vr user groupId
+ gi <- getGroupInfo db cxt user groupId
rs <- liftIO $ getGroupRelays db gi
pure (gi, rs)
assertUserGroupRole gInfo GROwner
@@ -2591,7 +2591,7 @@ processChatCommand vr nm = \case
_ -> False
APIAddMember groupId contactId memRole -> withUser $ \user -> withGroupLock "addMember" groupId $ do
-- TODO for large groups: no need to load all members to determine if contact is a member
- (group, contact) <- withFastStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db vr user contactId
+ (group, contact) <- withFastStore $ \db -> (,) <$> getGroup db cxt user groupId <*> getContact db cxt user contactId
let Group gInfo members = group
Contact {localDisplayName = cName} = contact
when (useRelays' gInfo) $ throwCmdError "can't invite contact to channel"
@@ -2622,8 +2622,8 @@ processChatCommand vr nm = \case
APIJoinGroup groupId enableNtfs -> withUser $ \user@User {userId} -> do
withGroupLock "joinGroup" groupId $ do
(invitation, ct) <- withFastStore $ \db -> do
- inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db vr user groupId
- (inv,) <$> getContactViaMember db vr user fromMember
+ inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db cxt user groupId
+ (inv,) <$> getContactViaMember db cxt user fromMember
let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership, chatSettings}} = invitation
GroupMember {memberId = membershipMemId} = membership
Contact {activeConn} = ct
@@ -2634,7 +2634,7 @@ processChatCommand vr nm = \case
agentConnId <- case memberConn fromMember of
Nothing -> do
agentConnId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff
- let chatV = vr `peerConnChatVersion` peerChatVRange
+ let chatV = vr cxt `peerConnChatVersion` peerChatVRange
void $ withFastStore' $ \db -> createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode
pure agentConnId
Just conn -> pure $ aConnId conn
@@ -2653,7 +2653,7 @@ processChatCommand vr nm = \case
pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
Nothing -> throwChatError $ CEContactNotActive ct
APIAcceptMember groupId gmId role -> withUser $ \user@User {userId} -> do
- (gInfo, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user gmId
+ (gInfo, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user gmId
assertUserGroupRole gInfo $ max GRModerator role
case memberStatus m of
GSMemPendingApproval | memberCategory m == GCInviteeMember -> do -- only host can approve
@@ -2662,14 +2662,14 @@ processChatCommand vr nm = \case
Just mConn ->
case memberAdmission >>= review of
Just MCAll -> do
- introduceToModerators vr user gInfo m
+ introduceToModerators cxt user gInfo m
withFastStore' $ \db -> updateGroupMemberStatus db userId m GSMemPendingReview
let m' = m {memberStatus = GSMemPendingReview}
pure $ CRMemberAccepted user gInfo m'
Nothing -> do
let msg = XGrpLinkAcpt GAAccepted role (memberId' m)
void $ sendDirectMemberMessage mConn msg groupId
- introduceToRemaining vr user gInfo m {memberRole = role}
+ introduceToRemaining cxt user gInfo m {memberRole = role}
when (groupFeatureAllowed SGFHistory gInfo) $ sendHistory user gInfo m
(m', gInfo') <- withFastStore' $ \db -> do
m' <- updateGroupMemberAccepted db user m GSMemConnected role
@@ -2684,7 +2684,7 @@ processChatCommand vr nm = \case
Nothing -> throwChatError CEGroupMemberNotActive
GSMemPendingReview -> do
let scope = Just $ GCSMemberSupport $ Just (groupMemberId' m)
- modMs <- withFastStore' $ \db -> getGroupModerators db vr user gInfo
+ modMs <- withFastStore' $ \db -> getGroupModerators db cxt user gInfo
let rcpModMs' = filter memberCurrent modMs
msg = XGrpLinkAcpt GAAccepted role (memberId' m)
void $ sendGroupMessage user gInfo scope ([m] <> rcpModMs') msg
@@ -2693,7 +2693,7 @@ processChatCommand vr nm = \case
let msg2 = XMsgNew $ mcSimple (MCText acceptedToGroupMessage)
void $ sendDirectMemberMessage mConn msg2 groupId
when (memberCategory m == GCInviteeMember) $ do
- introduceToRemaining vr user gInfo m {memberRole = role}
+ introduceToRemaining cxt user gInfo m {memberRole = role}
when (groupFeatureAllowed SGFHistory gInfo) $ sendHistory user gInfo m
(m', gInfo') <- withFastStore' $ \db -> do
m' <- updateGroupMemberAccepted db user m newMemberStatus role
@@ -2711,7 +2711,7 @@ processChatCommand vr nm = \case
_ -> GSMemAnnounced
_ -> throwCmdError "member should be pending approval and invitee, or pending review and not invitee"
APIDeleteMemberSupportChat groupId gmId -> withUser $ \user -> do
- (gInfo, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user gmId
+ (gInfo, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user gmId
when (isNothing $ supportChat m) $ throwCmdError "member has no support chat"
when (memberPending m) $ throwCmdError "member is pending"
(gInfo', m') <- withFastStore' $ \db -> do
@@ -2725,7 +2725,7 @@ processChatCommand vr nm = \case
APIMembersRole groupId memberIds newRole -> withUser $ \user ->
withGroupLock "memberRole" groupId $ do
-- TODO [relays] possible optimization is to read only required members + relays
- g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
+ g@(Group gInfo members) <- withFastStore $ \db -> getGroup db cxt user groupId
when (selfSelected gInfo) $ throwCmdError "can't change role for self"
let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin, anyPending, anyPrivilegedTarget, finalPrivilegedCount) = selectMembers members
when (length invitedMems + length currentMems + length unchangedMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
@@ -2774,7 +2774,7 @@ processChatCommand vr nm = \case
where
changeRole :: GroupMember -> CM GroupMember
changeRole m@GroupMember {groupMemberId, memberContactId, localDisplayName = cName} = do
- withFastStore (\db -> (,) <$> mapM (getContact db vr user) memberContactId <*> liftIO (getMemberInvitation db user groupMemberId)) >>= \case
+ withFastStore (\db -> (,) <$> mapM (getContact db cxt user) memberContactId <*> liftIO (getMemberInvitation db user groupMemberId)) >>= \case
(Just ct, Just cReq) -> do
sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = newRole} cReq
withFastStore' $ \db -> updateGroupMemberRole db user m newRole
@@ -2806,7 +2806,7 @@ processChatCommand vr nm = \case
APIBlockMembersForAll groupId memberIds blockFlag -> withUser $ \user ->
withGroupLock "blockForAll" groupId $ do
-- TODO [relays] possible optimization is to read only required members + relays
- Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
+ Group gInfo members <- withFastStore $ \db -> getGroup db cxt user groupId
when (selfSelected gInfo) $ throwCmdError "can't block/unblock self"
-- TODO [relays] consider sending restriction to all members (remove filtering), as we do in delivery jobs
let (blockMems, remainingMems, maxRole, anyAdmin, anyPending) = selectMembers members
@@ -2855,7 +2855,7 @@ processChatCommand vr nm = \case
APIRemoveMembers {groupId, groupMemberIds, withMessages} -> withUser $ \user ->
withGroupLock "removeMembers" groupId $ do
-- TODO [relays] possible optimization is to read only required members + relays
- Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
+ Group gInfo members <- withFastStore $ \db -> getGroup db cxt user groupId
let (count, invitedMems, pendingApprvMems, pendingRvwMems, currentMems, maxRole, anyAdmin, anyPrivilegedRemoved) = selectMembers gmIds members
gmIds = S.fromList $ L.toList groupMemberIds
memCount = length groupMemberIds
@@ -2880,7 +2880,7 @@ processChatCommand vr nm = \case
gInfo' <-
if useRelays' gInfo
then updatePublicGroupData user gInfo
- else withFastStore $ \db -> getGroupInfo db vr user groupId
+ else withFastStore $ \db -> getGroupInfo db cxt user groupId
let acis' = map (updateACIGroupInfo gInfo') acis
unless (null acis') $ toView $ CEvtNewChatItems user acis'
unless (null errs) $ toView $ CEvtChatErrors errs
@@ -2960,7 +2960,7 @@ processChatCommand vr nm = \case
| groupFeatureUserAllowed SGFFullDelete gInfo = deleteGroupMembersCIs user gInfo ms
| otherwise = markGroupMembersCIsDeleted user gInfo ms membership
APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
- gInfo@GroupInfo {membership} <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo@GroupInfo {membership} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo
withGroupLock "leaveGroup" groupId $ do
cancelFilesInProgress user filesInfo
@@ -2999,26 +2999,26 @@ processChatCommand vr nm = \case
pure msg
getRecipients user gInfo
| useRelays' gInfo = do
- relays <- withFastStore' $ \db -> getGroupRelayMembers db vr user gInfo
+ relays <- withFastStore' $ \db -> getGroupRelayMembers db cxt user gInfo
pure (relays, relays)
| otherwise = do
- ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
+ ms <- withFastStore' $ \db -> getGroupMembers db cxt user gInfo
pure (ms, filter memberCurrentOrPending ms)
APIListMembers groupId -> withUser $ \user ->
- CRGroupMembers user <$> withFastStore (\db -> getGroup db vr user groupId)
+ CRGroupMembers user <$> withFastStore (\db -> getGroup db cxt user groupId)
-- -- validate: prohibit to delete/archive if member is pending (has to communicate approval or rejection)
-- APIDeleteGroupConversations groupId _gcId -> withUser $ \user -> do
- -- _gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ -- _gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
-- ok_ -- CRGroupConversationsArchived
-- APIArchiveGroupConversations groupId _gcId -> withUser $ \user -> do
- -- _gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ -- _gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
-- ok_ -- CRGroupConversationsDeleted
AddMember gName cName memRole -> withUser $ \user -> do
(groupId, contactId) <- withFastStore $ \db -> (,) <$> getGroupIdByName db user gName <*> getContactIdByName db user cName
- processChatCommand vr nm $ APIAddMember groupId contactId memRole
+ processChatCommand cxt nm $ APIAddMember groupId contactId memRole
JoinGroup gName enableNtfs -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIJoinGroup groupId enableNtfs
+ processChatCommand cxt nm $ APIJoinGroup groupId enableNtfs
AcceptMember gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIAcceptMember gId gMemberId memRole
MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMembersRole gId [gMemberId] memRole
BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMembersForAll gId [gMemberId] blocked
@@ -3027,45 +3027,45 @@ processChatCommand vr nm = \case
gId <- getGroupIdByName db user gName
gMemberIds <- mapM (getGroupMemberIdByName db user gId) gMemberNames
pure (gId, gMemberIds)
- processChatCommand vr nm $ APIRemoveMembers gId gMemberIds withMessages
+ processChatCommand cxt nm $ APIRemoveMembers gId gMemberIds withMessages
LeaveGroup gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APILeaveGroup groupId
+ processChatCommand cxt nm $ APILeaveGroup groupId
AllowRelayGroup gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIAllowRelayGroup groupId
+ processChatCommand cxt nm $ APIAllowRelayGroup groupId
DeleteGroup gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIDeleteChat (ChatRef CTGroup groupId Nothing) (CDMFull True)
+ processChatCommand cxt nm $ APIDeleteChat (ChatRef CTGroup groupId Nothing) (CDMFull True)
ClearGroup gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIClearChat (ChatRef CTGroup groupId Nothing)
+ processChatCommand cxt nm $ APIClearChat (ChatRef CTGroup groupId Nothing)
ListMembers gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIListMembers groupId
+ processChatCommand cxt nm $ APIListMembers groupId
ListMemberSupportChats gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- (Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
+ (Group gInfo members) <- withFastStore $ \db -> getGroup db cxt user groupId
let memberSupportChats = filter (isJust . supportChat) members
pure $ CRMemberSupportChats user gInfo memberSupportChats
APIListGroups userId contactId_ search_ -> withUserId userId $ \user ->
- CRGroupsList user <$> withFastStore' (\db -> getBaseGroupDetails db vr user contactId_ search_)
+ CRGroupsList user <$> withFastStore' (\db -> getBaseGroupDetails db cxt user contactId_ search_)
ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do
- ct_ <- forM cName_ $ \cName -> withFastStore $ \db -> getContactByName db vr user cName
- processChatCommand vr nm $ APIListGroups userId (contactId' <$> ct_) search_
+ ct_ <- forM cName_ $ \cName -> withFastStore $ \db -> getContactByName db cxt user cName
+ processChatCommand cxt nm $ APIListGroups userId (contactId' <$> ct_) search_
APIUpdateGroupProfile groupId p' -> withUser $ \user -> do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
runUpdateGroupProfile user gInfo p'
UpdateGroupNames gName GroupProfile {displayName, fullName, shortDescr} ->
updateGroupProfileByName gName $ \p -> p {displayName, fullName, shortDescr}
ShowGroupProfile gName -> withUser $ \user ->
- CRGroupProfile user <$> withFastStore (\db -> getGroupInfoByName db vr user gName)
+ CRGroupProfile user <$> withFastStore (\db -> getGroupInfoByName db cxt user gName)
UpdateGroupDescription gName description ->
updateGroupProfileByName gName $ \p -> p {description}
ShowGroupDescription gName -> withUser $ \user ->
- CRGroupDescription user <$> withFastStore (\db -> getGroupInfoByName db vr user gName)
+ CRGroupDescription user <$> withFastStore (\db -> getGroupInfoByName db cxt user gName)
APICreateGroupLink groupId mRole -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do
- gInfo@GroupInfo {groupProfile} <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo@GroupInfo {groupProfile} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
assertUserGroupRole gInfo GRAdmin
when (mRole > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole
groupLinkId <- GroupLinkId <$> drgRandomBytes 16
@@ -3079,7 +3079,7 @@ processChatCommand vr nm = \case
gLink <- withFastStore $ \db -> createGroupLink db gVar user gInfo connId ccLink' groupLinkId mRole subMode
pure $ CRGroupLinkCreated user gInfo gLink
APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withGroupLock "groupLinkMemberRole" groupId $ do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
gLnk@GroupLink {acceptMemberRole} <- withFastStore $ \db -> getGroupLink db user gInfo
assertUserGroupRole gInfo GRAdmin
when (mRole' > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole'
@@ -3089,22 +3089,22 @@ processChatCommand vr nm = \case
else pure gLnk
pure $ CRGroupLink user gInfo gLnk'
APIDeleteGroupLink groupId -> withUser $ \user -> withGroupLock "deleteGroupLink" groupId $ do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
deleteGroupLink' user gInfo
pure $ CRGroupLinkDeleted user gInfo
APIGetGroupLink groupId -> withUser $ \user -> do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
gLnk <- withFastStore $ \db -> getGroupLink db user gInfo
pure $ CRGroupLink user gInfo gLnk
APIAddGroupShortLink groupId -> withUser $ \user -> do
(gInfo, gLink) <- withFastStore $ \db -> do
- gInfo <- getGroupInfo db vr user groupId
+ gInfo <- getGroupInfo db cxt user groupId
gLink <- getGroupLink db user gInfo
pure (gInfo, gLink)
gLink' <- setGroupLinkData nm user gInfo gLink
pure $ CRGroupLink user gInfo gLink'
APICreateMemberContact gId gMemberId -> withUser $ \user -> do
- (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
+ (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user gId <*> getGroupMember db cxt user gId gMemberId
assertUserGroupRole g GRAuthor
unless (groupFeatureUserAllowed SGFDirectMessages g) $ throwCmdError "direct messages not allowed"
case memberConn m of
@@ -3121,7 +3121,7 @@ processChatCommand vr nm = \case
pure $ CRNewMemberContact user ct g m
_ -> throwChatError CEGroupMemberNotActive
APISendMemberContactInvitation contactId msgContent_ -> withUser $ \user -> do
- (g@GroupInfo {groupId}, m, ct, cReq) <- withFastStore $ \db -> getMemberContact db vr user contactId
+ (g@GroupInfo {groupId}, m, ct, cReq) <- withFastStore $ \db -> getMemberContact db cxt user contactId
when (contactGrpInvSent ct) $ throwCmdError "x.grp.direct.inv already sent"
case memberConn m of
Just mConn -> do
@@ -3136,17 +3136,17 @@ processChatCommand vr nm = \case
pure $ CRNewMemberContactSentInv user ct' g m
_ -> throwChatError CEGroupMemberNotActive
APIAcceptMemberContact contactId -> withUser $ \user -> do
- (g, mConn, ct, groupDirectInv) <- withFastStore $ \db -> getMemberContactInvited db vr user contactId
+ (g, mConn, ct, groupDirectInv) <- withFastStore $ \db -> getMemberContactInvited db cxt user contactId
when (groupDirectInvStartedConnection groupDirectInv) $ throwCmdError "connection already started"
connectMemberContact user g mConn ct groupDirectInv `catchAllErrors` \e -> do
-- get updated contact, in case connection was started
- ct' <- withFastStore $ \db -> getContact db vr user contactId
+ ct' <- withFastStore $ \db -> getContact db cxt user contactId
toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
throwError e
-- get updated contact (groupDirectInvStartedConnection) with connection
ct' <- withFastStore $ \db -> do
liftIO $ setMemberContactStartedConnection db ct
- getContact db vr user contactId
+ getContact db cxt user contactId
pure $ CRMemberContactAccepted user ct'
where
connectMemberContact user gInfo mConn Contact {activeConn} GroupDirectInvitation {groupDirectInvLink = cReq} =
@@ -3168,7 +3168,7 @@ processChatCommand vr nm = \case
acId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq PQSupportOff
conn <- withStore $ \db -> do
connId <- liftIO $ createMemberContactConn db user acId Nothing gInfo mConn ConnPrepared contactId subMode
- getConnectionById db vr user connId
+ getConnectionById db cxt user connId
joinPreparedConn subMode conn
joinPreparedConn subMode conn = do
-- [incognito] send membership incognito profile
@@ -3179,66 +3179,66 @@ processChatCommand vr nm = \case
void $ withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared newStatus
CreateGroupLink gName mRole -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APICreateGroupLink groupId mRole
+ processChatCommand cxt nm $ APICreateGroupLink groupId mRole
GroupLinkMemberRole gName mRole -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIGroupLinkMemberRole groupId mRole
+ processChatCommand cxt nm $ APIGroupLinkMemberRole groupId mRole
DeleteGroupLink gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIDeleteGroupLink groupId
+ processChatCommand cxt nm $ APIDeleteGroupLink groupId
ShowGroupLink gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
- processChatCommand vr nm $ APIGetGroupLink groupId
+ processChatCommand cxt nm $ APIGetGroupLink groupId
SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do
(gInfo, quotedItemId, mentions) <-
withFastStore $ \db -> do
- gInfo <- getGroupInfoByName db vr user gName
+ gInfo <- getGroupInfoByName db cxt user gName
let gId = groupId' gInfo
qiId <- getGroupChatItemIdByText db user gId cName quotedMsg
(gInfo, qiId,) <$> liftIO (getMessageMentions db user gId msg)
let mc = MCText msg
- processChatCommand vr nm $ APISendMessages (SRGroup (groupId' gInfo) Nothing (sendAsGroup' gInfo Nothing)) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc mentions]
+ processChatCommand cxt nm $ APISendMessages (SRGroup (groupId' gInfo) Nothing (sendAsGroup' gInfo Nothing)) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc mentions]
ClearNoteFolder -> withUser $ \user -> do
folderId <- withFastStore (`getUserNoteFolderId` user)
- processChatCommand vr nm $ APIClearChat (ChatRef CTLocal folderId Nothing)
+ processChatCommand cxt nm $ APIClearChat (ChatRef CTLocal folderId Nothing)
LastChats count_ -> withUser' $ \user -> do
let count = fromMaybe 5000 count_
- (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db vr user False (PTLast count) clqNoFilters)
+ (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db cxt user False (PTLast count) clqNoFilters)
unless (null errs) $ toView $ CEvtChatErrors (map ChatErrorStore errs)
pure $ CRChats previews
LastMessages (Just chatName) count search -> withUser $ \user -> do
chatRef <- getChatRef user chatName
- chatResp <- processChatCommand vr nm $ APIGetChat chatRef Nothing (CPLast count) search
+ chatResp <- processChatCommand cxt nm $ APIGetChat chatRef Nothing (CPLast count) search
pure $ CRChatItems user (Just chatName) (aChatItems . chat $ chatResp)
LastMessages Nothing count search -> withUser $ \user -> do
- chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast count) search
+ chatItems <- withFastStore $ \db -> getAllChatItems db cxt user (CPLast count) search
pure $ CRChatItems user Nothing chatItems
LastChatItemId (Just chatName) index -> withUser $ \user -> do
chatRef <- getChatRef user chatName
- chatResp <- processChatCommand vr nm $ APIGetChat chatRef Nothing (CPLast $ index + 1) Nothing
+ chatResp <- processChatCommand cxt nm $ APIGetChat chatRef Nothing (CPLast $ index + 1) Nothing
pure $ CRChatItemId user (fmap aChatItemId . listToMaybe . aChatItems . chat $ chatResp)
LastChatItemId Nothing index -> withUser $ \user -> do
- chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast $ index + 1) Nothing
+ chatItems <- withFastStore $ \db -> getAllChatItems db cxt user (CPLast $ index + 1) Nothing
pure $ CRChatItemId user (fmap aChatItemId . listToMaybe $ chatItems)
ShowChatItem (Just itemId) -> withUser $ \user -> do
chatItem <- withFastStore $ \db -> do
chatRef <- getChatRefViaItemId db user itemId
- getAChatItem db vr user chatRef itemId
+ getAChatItem db cxt user chatRef itemId
pure $ CRChatItems user Nothing ((: []) chatItem)
ShowChatItem Nothing -> withUser $ \user -> do
- chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast 1) Nothing
+ chatItems <- withFastStore $ \db -> getAllChatItems db cxt user (CPLast 1) Nothing
pure $ CRChatItems user Nothing chatItems
ShowChatItemInfo chatName msg -> withUser $ \user -> do
chatRef <- getChatRef user chatName
itemId <- getChatItemIdByText user chatRef msg
- processChatCommand vr nm $ APIGetChatItemInfo chatRef itemId
+ processChatCommand cxt nm $ APIGetChatItemInfo chatRef itemId
ShowLiveItems on -> withUser $ \_ ->
asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
SendFile chatName f -> withUser $ \user -> do
chatRef <- getChatRef user chatName
case chatRef of
- ChatRef CTLocal folderId _ -> processChatCommand vr nm $ APICreateChatItems folderId [composedMessage (Just f) (MCFile "")]
- _ -> withSendRef user chatRef $ \sendRef -> processChatCommand vr nm $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCFile "")]
+ ChatRef CTLocal folderId _ -> processChatCommand cxt nm $ APICreateChatItems folderId [composedMessage (Just f) (MCFile "")]
+ _ -> withSendRef user chatRef $ \sendRef -> processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCFile "")]
SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do
chatRef <- getChatRef user chatName
withSendRef user chatRef $ \sendRef -> do
@@ -3247,7 +3247,7 @@ processChatCommand vr nm = \case
fileSize <- getFileSize filePath
unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
-- TODO include file description for preview
- processChatCommand vr nm $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCImage "" fixedImagePreview)]
+ processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCImage "" fixedImagePreview)]
ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
SendFileDescription _chatName _f -> throwCmdError "TODO"
@@ -3274,18 +3274,18 @@ processChatCommand vr nm = \case
| otherwise -> do
cancelSndFile user ftm fts True
cref_ <- withFastStore' $ \db -> lookupChatRefByFileId db user fileId
- aci_ <- withFastStore $ \db -> lookupChatItemByFileId db vr user fileId
+ aci_ <- withFastStore $ \db -> lookupChatItemByFileId db cxt user fileId
case (cref_, aci_) of
(Nothing, _) ->
pure $ CRSndFileCancelled user Nothing ftm fts
(Just (ChatRef CTDirect contactId _), Just aci) -> do
- (contact, sharedMsgId) <- withFastStore $ \db -> (,) <$> getContact db vr user contactId <*> getSharedMsgIdByFileId db userId fileId
+ (contact, sharedMsgId) <- withFastStore $ \db -> (,) <$> getContact db cxt user contactId <*> getSharedMsgIdByFileId db userId fileId
void . sendDirectContactMessage user contact $ XFileCancel sharedMsgId
pure $ CRSndFileCancelled user (Just aci) ftm fts
(Just (ChatRef CTGroup groupId scope), Just aci) -> do
- (gInfo, sharedMsgId) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getSharedMsgIdByFileId db userId fileId
- chatScopeInfo <- mapM (getChatScopeInfo vr user) scope
- recipients <- getGroupRecipients vr user gInfo chatScopeInfo groupKnockingVersion
+ (gInfo, sharedMsgId) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user groupId <*> getSharedMsgIdByFileId db userId fileId
+ chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope
+ recipients <- getGroupRecipients cxt user gInfo chatScopeInfo groupKnockingVersion
void . sendGroupMessage user gInfo scope recipients $ XFileCancel sharedMsgId
pure $ CRSndFileCancelled user (Just aci) ftm fts
(Just _, _) -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
@@ -3298,7 +3298,7 @@ processChatCommand vr nm = \case
| otherwise -> case xftpRcvFile of
Nothing -> do
cancelRcvFileTransfer user ftr
- ci <- withFastStore $ \db -> lookupChatItemByFileId db vr user fileId
+ ci <- withFastStore $ \db -> lookupChatItemByFileId db cxt user fileId
pure $ CRRcvFileCancelled user ci ftr
Just XFTPRcvFile {agentRcvFileId} -> do
forM_ (liveRcvFileTransferPath ftr) $ \filePath -> do
@@ -3309,7 +3309,7 @@ processChatCommand vr nm = \case
aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation
pure $ CRRcvFileCancelled user aci_ ftr
FileStatus fileId -> withUser $ \user -> do
- withFastStore (\db -> lookupChatItemByFileId db vr user fileId) >>= \case
+ withFastStore (\db -> lookupChatItemByFileId db cxt user fileId) >>= \case
Nothing -> do
fileStatus <- withFastStore $ \db -> getFileTransferProgress db user fileId
pure $ CRFileTransferStatus user fileStatus
@@ -3338,7 +3338,7 @@ processChatCommand vr nm = \case
let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user}
updateProfile user p
SetContactFeature (ACF f) cName allowed_ -> withUser $ \user -> do
- ct@Contact {userPreferences} <- withFastStore $ \db -> getContactByName db vr user cName
+ ct@Contact {userPreferences} <- withFastStore $ \db -> getContactByName db cxt user cName
let prefs' = setPreference f allowed_ $ Just userPreferences
updateContactPrefs user ct prefs'
SetGroupFeature (AGFNR f) gName enabled ->
@@ -3358,7 +3358,7 @@ processChatCommand vr nm = \case
p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user}
updateProfile user p
SetContactTimedMessages cName timedMessagesEnabled_ -> withUser $ \user -> do
- ct@Contact {userPreferences = userPreferences@Preferences {timedMessages}} <- withFastStore $ \db -> getContactByName db vr user cName
+ ct@Contact {userPreferences = userPreferences@Preferences {timedMessages}} <- withFastStore $ \db -> getContactByName db cxt user cName
let currentTTL = timedMessages >>= \TimedMessagesPreference {ttl} -> ttl
pref_ = tmeToPref currentTTL <$> timedMessagesEnabled_
prefs' = setPreference' SCFTimedMessages pref_ $ Just userPreferences
@@ -3473,7 +3473,7 @@ processChatCommand vr nm = \case
_ -> throwCmdError "not supported"
pure $ ChatRef cType chatId Nothing
getSendAsGroup :: User -> ChatRef -> CM ShowGroupAsSender
- getSendAsGroup user' (ChatRef CTGroup chatId scope) = (`sendAsGroup'` scope) <$> withFastStore (\db -> getGroupInfo db vr user' chatId)
+ getSendAsGroup user' (ChatRef CTGroup chatId scope) = (`sendAsGroup'` scope) <$> withFastStore (\db -> getGroupInfo db cxt user' chatId)
getSendAsGroup _ _ = pure False
getChatRefAndMentions :: User -> ChatName -> Text -> CM (ChatRef, Map MemberName GroupMemberId)
getChatRefAndMentions user cName msg = do
@@ -3492,13 +3492,13 @@ processChatCommand vr nm = \case
checkStoreNotChanged :: CM ChatResponse -> CM ChatResponse
checkStoreNotChanged = ifM (asks chatStoreChanged >>= readTVarIO) (throwChatError CEChatStoreChanged)
withUserName :: UserName -> (UserId -> ChatCommand) -> CM ChatResponse
- withUserName uName cmd = withFastStore (`getUserIdByName` uName) >>= processChatCommand vr nm . cmd
+ withUserName uName cmd = withFastStore (`getUserIdByName` uName) >>= processChatCommand cxt nm . cmd
withContactName :: ContactName -> (ContactId -> ChatCommand) -> CM ChatResponse
withContactName cName cmd = withUser $ \user ->
- withFastStore (\db -> getContactIdByName db user cName) >>= processChatCommand vr nm . cmd
+ withFastStore (\db -> getContactIdByName db user cName) >>= processChatCommand cxt nm . cmd
withMemberName :: GroupName -> ContactName -> (GroupId -> GroupMemberId -> ChatCommand) -> CM ChatResponse
withMemberName gName mName cmd = withUser $ \user ->
- getGroupAndMemberId user gName mName >>= processChatCommand vr nm . uncurry cmd
+ getGroupAndMemberId user gName mName >>= processChatCommand cxt nm . uncurry cmd
getConnectionCode :: ConnId -> CM Text
getConnectionCode connId = verificationCode <$> withAgent (`getConnectionRatchetAdHash` connId)
verifyConnectionCode :: User -> Connection -> Maybe Text -> CM ChatResponse
@@ -3532,7 +3532,7 @@ processChatCommand vr nm = \case
-- TODO PQ the error above should be CEIncompatibleConnReqVersion, also the same API should be called in Plan
Just (agentV, pqSup') -> do
let chatV = agentToChatVersion agentV
- withFastStore' (\db -> getConnectionEntityByConnReq db vr user cReqs) >>= \case
+ withFastStore' (\db -> getConnectionEntityByConnReq db cxt user cReqs) >>= \case
Nothing -> joinNewConn chatV
Just (RcvDirectMsgConnection conn@Connection {connStatus, contactConnInitiated, customUserProfileId} _ct_)
| connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV -- own connection link
@@ -3576,7 +3576,7 @@ processChatCommand vr nm = \case
ConnPrepared -> joinPreparedConn' xContactId conn (Just $ Just gInfo)
_ -> connect' groupLinkId xContactId (Just $ Just gInfo) -- why not "already connected" for host member?
Nothing ->
- withFastStore' (\db -> getConnReqContactXContactId db vr user cReqHash1 cReqHash2) >>= \case
+ withFastStore' (\db -> getConnReqContactXContactId db cxt user cReqHash1 cReqHash2) >>= \case
Right ct@Contact {activeConn} -> case groupLinkId of
Nothing -> case activeConn of
Just conn@Connection {connStatus = ConnPrepared, xContactId} -> joinPreparedConn' xContactId conn Nothing
@@ -3636,7 +3636,7 @@ processChatCommand vr nm = \case
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq cReqHash shortLink newXContactId (NewIncognito <$> incognitoProfile) Nothing subMode chatV pqSup
void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing Nothing Nothing pqSup
- ct' <- withStore $ \db -> getContact db vr user contactId
+ ct' <- withStore $ \db -> getContact db cxt user contactId
pure $ CRSentInvitationToContact user ct' incognitoProfile
Just conn@Connection {connStatus, xContactId = xContactId_, customUserProfileId} -> case connStatus of
ConnPrepared -> do
@@ -3645,14 +3645,14 @@ processChatCommand vr nm = \case
localIncognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
let incognitoProfile = fromLocalProfile <$> localIncognitoProfile
void $ joinContact user conn cReq incognitoProfile xContactId Nothing Nothing Nothing Nothing PQSupportOn
- ct' <- withStore $ \db -> getContact db vr user contactId
+ ct' <- withStore $ \db -> getContact db cxt user contactId
pure $ CRSentInvitationToContact user ct' incognitoProfile
_ -> throwCmdError "contact already has connection"
connectToRelay :: User -> GroupInfo -> ShortLinkContact -> CM (ShortLinkContact, GroupMember, Either ChatError ())
connectToRelay user gInfo relayLink = do
gVar <- asks random
-- Save relayLink to re-use relay member record on retry (check by relayLink)
- relayMember <- withFastStore $ \db -> getCreateRelayForMember db vr gVar user gInfo relayLink
+ relayMember <- withFastStore $ \db -> getCreateRelayForMember db cxt gVar user gInfo relayLink
r <- tryAllErrors $ do
(fd@FixedLinkData {rootKey = relayKey, linkEntityId}, cData) <- getShortLinkConnReq nm user relayLink
relayLinkData_ <- liftIO $ decodeLinkUserData cData
@@ -3664,11 +3664,11 @@ processChatCommand vr nm = \case
let cReq = linkConnReq fd
relayLinkToConnect = CCLink cReq (Just relayLink)
void $ connectViaContact user (Just $ PCEGroup gInfo (relayMember {memberId = relayMemberId})) (incognitoMembership gInfo) relayLinkToConnect Nothing Nothing
- relayMember' <- withFastStore $ \db -> getGroupMember db vr user (groupId' gInfo) (groupMemberId' relayMember)
+ relayMember' <- withFastStore $ \db -> getGroupMember db cxt user (groupId' gInfo) (groupMemberId' relayMember)
pure (relayLink, relayMember', r)
syncSubscriberRelays :: User -> GroupInfo -> [ShortLinkContact] -> CM ()
syncSubscriberRelays user gInfo currentRelayLinks = void . tryAllErrors $ do
- localRelayMembers <- withFastStore' $ \db -> getGroupRelayMembers db vr user gInfo
+ localRelayMembers <- withFastStore' $ \db -> getGroupRelayMembers db cxt user gInfo
let activeRelayMembers = filter memberCurrent localRelayMembers
memberRelayLink GroupMember {relayLink = rl} = rl
localRelayLinks = mapMaybe memberRelayLink activeRelayMembers
@@ -3734,7 +3734,7 @@ processChatCommand vr nm = \case
| otherwise = do
when (n /= n') $ checkValidName n'
-- read contacts before user update to correctly merge preferences
- contacts <- withFastStore' $ \db -> getUserContacts db vr user
+ contacts <- withFastStore' $ \db -> getUserContacts db cxt user
user' <- updateUser
asks currentUser >>= atomically . (`writeTVar` Just user')
withChatLock "updateProfile" $ do
@@ -3786,7 +3786,7 @@ processChatCommand vr nm = \case
(conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId]))
setMyAddressData :: User -> UserContactLink -> CM UserContactLink
setMyAddressData user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _sLnk_, addressSettings} = do
- conn <- withFastStore $ \db -> getUserAddressConnection db vr user
+ conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
let shortLinkProfile = userProfileDirect user Nothing Nothing True
-- TODO [short links] do not save address to server if data did not change, spinners, error handling
userData
@@ -3820,12 +3820,12 @@ processChatCommand vr nm = \case
gInfo' <- withStore $ \db -> updateGroupProfile db user gInfo p'
msg <- case businessChat of
Just BusinessChatInfo {businessId} -> do
- ms <- withStore' $ \db -> getGroupMembers db vr user gInfo'
+ ms <- withStore' $ \db -> getGroupMembers db cxt user gInfo'
let (newMs, oldMs) = partition (\m -> maxVersion (memberChatVRange m) >= businessChatPrefsVersion) ms
-- this is a fallback to send the members with the old version correct profile of the business when preferences change
unless (null oldMs) $ do
GroupMember {memberProfile = LocalProfile {displayName, fullName, shortDescr, image}} <-
- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo' businessId
+ withStore $ \db -> getGroupMemberByMemberId db cxt user gInfo' businessId
let p'' = p' {displayName, fullName, shortDescr, image} :: GroupProfile
recipients = filter memberCurrentOrPending oldMs
void $ sendGroupMessage user gInfo' Nothing recipients (XGrpInfo p'')
@@ -3838,9 +3838,9 @@ processChatCommand vr nm = \case
sendGroupMessage user gInfo' Nothing recipients (XGrpInfo p')
where
getRecipients
- | useRelays' gInfo' = withFastStore' $ \db -> getGroupRelayMembers db vr user gInfo'
+ | useRelays' gInfo' = withFastStore' $ \db -> getGroupRelayMembers db cxt user gInfo'
| otherwise = do
- ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo'
+ ms <- withFastStore' $ \db -> getGroupMembers db cxt user gInfo'
pure $ filter memberCurrentOrPending ms
let cd = CDGroupSnd gInfo' Nothing
unless (sameGroupProfileInfo p p') $ do
@@ -3901,13 +3901,13 @@ processChatCommand vr nm = \case
updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName gName update = withUser $ \user -> do
gInfo@GroupInfo {groupProfile = p} <- withStore $ \db ->
- getGroupIdByName db user gName >>= getGroupInfo db vr user
+ getGroupIdByName db user gName >>= getGroupInfo db cxt user
runUpdateGroupProfile user gInfo $ update p
withCurrentCall :: ContactId -> (User -> Contact -> Call -> CM (Maybe Call)) -> CM ChatResponse
withCurrentCall ctId action = do
(user, ct) <- withStore $ \db -> do
user <- getUserByContactId db ctId
- (user,) <$> getContact db vr user ctId
+ (user,) <$> getContact db cxt user ctId
calls <- asks currentCalls
withContactLock "currentCall" ctId $
atomically (TM.lookup ctId calls) >>= \case
@@ -3949,7 +3949,7 @@ processChatCommand vr nm = \case
FTSnd {fileTransferMeta = FileTransferMeta {filePath, xftpSndFile}} -> forward filePath $ xftpSndFile >>= \XFTPSndFile {cryptoArgs} -> cryptoArgs
_ -> throwChatError CEFileNotReceived {fileId}
where
- forward path cfArgs = processChatCommand vr nm $ sendCommand chatName $ CryptoFile path cfArgs
+ forward path cfArgs = processChatCommand cxt nm $ sendCommand chatName $ CryptoFile path cfArgs
getGroupAndMemberId :: User -> GroupName -> ContactName -> CM (GroupId, GroupMemberId)
getGroupAndMemberId user gName groupMemberName =
withStore $ \db -> do
@@ -3961,7 +3961,7 @@ processChatCommand vr nm = \case
checkValidName displayName
-- [incognito] generate incognito profile for group membership
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
- withFastStore $ \db -> createNewGroup db vr user gProfile incognitoProfile useRelays memberId groupKeys_ publicMemberCount_
+ withFastStore $ \db -> createNewGroup db cxt user gProfile incognitoProfile useRelays memberId groupKeys_ publicMemberCount_
createNewGroupItems :: User -> GroupInfo -> CM ()
createNewGroupItems user gInfo = do
let cd = CDGroupSnd gInfo Nothing
@@ -4004,9 +4004,9 @@ processChatCommand vr nm = \case
subMode <- chatReadVar subscriptionMode
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq PQSupportOff
(relayMember, conn, groupRelay) <- withFastStore $ \db -> do
- relayMember <- createRelayForOwner db vr gVar user gInfo relay
+ relayMember <- createRelayForOwner db cxt gVar user gInfo relay
groupRelay <- createGroupRelayRecord db gInfo relayMember relay
- conn <- createRelayConnection db vr user (groupMemberId' relayMember) connId ConnPrepared chatV subMode
+ conn <- createRelayConnection db cxt user (groupMemberId' relayMember) connId ConnPrepared chatV subMode
pure (relayMember, conn, groupRelay)
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
allowSimplexLinks = groupFeatureUserAllowed SGFSimplexLinks gInfo
@@ -4078,15 +4078,15 @@ processChatCommand vr nm = \case
(chatId, chatSettings) <- case cType of
CTDirect -> withFastStore $ \db -> do
ctId <- getContactIdByName db user name
- Contact {chatSettings} <- getContact db vr user ctId
+ Contact {chatSettings} <- getContact db cxt user ctId
pure (ctId, chatSettings)
CTGroup ->
withFastStore $ \db -> do
gId <- getGroupIdByName db user name
- GroupInfo {chatSettings} <- getGroupInfo db vr user gId
+ GroupInfo {chatSettings} <- getGroupInfo db cxt user gId
pure (gId, chatSettings)
_ -> throwCmdError "not supported"
- processChatCommand vr nm $ APISetChatSettings (ChatRef cType chatId Nothing) $ updateSettings chatSettings
+ processChatCommand cxt nm $ APISetChatSettings (ChatRef cType chatId Nothing) $ updateSettings chatSettings
connectPlan :: User -> AConnectionLink -> Bool -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan)
connectPlan user (ACL SCMInvitation cLink) _ sig_ = case cLink of
CLFull cReq -> invitationReqAndPlan cReq Nothing Nothing Nothing
@@ -4102,10 +4102,10 @@ processChatCommand vr nm = \case
where
knownLinkPlans l' = withFastStore $ \db -> do
let inv cReq = ACCL SCMInvitation $ CCLink cReq (Just l')
- liftIO (getConnectionEntityViaShortLink db vr user l') >>= \case
+ liftIO (getConnectionEntityViaShortLink db cxt user l') >>= \case
Just (cReq, ent) -> pure $ Just (inv cReq, invitationEntityPlan Nothing Nothing ent)
-- deleted contact is returned as known, as invitation link cannot be re-used too connect anyway
- Nothing -> bimap inv (CPInvitationLink . ILPKnown) <$$> getContactViaShortLinkToConnect db vr user l'
+ Nothing -> bimap inv (CPInvitationLink . ILPKnown) <$$> getContactViaShortLinkToConnect db cxt user l'
invitationReqAndPlan cReq sLnk_ cld ov = do
plan <- invitationRequestPlan user cReq cld ov `catchAllErrors` (pure . CPError)
pure (ACCL SCMInvitation (CCLink cReq sLnk_), plan)
@@ -4120,7 +4120,7 @@ processChatCommand vr nm = \case
Just r -> pure r
Nothing -> do
(FixedLinkData {linkConnReq = cReq, rootKey}, cData) <- getShortLinkConnReq nm user l'
- withFastStore' (\db -> getContactWithoutConnViaShortAddress db vr user l') >>= \case
+ withFastStore' (\db -> getContactWithoutConnViaShortAddress db cxt user l') >>= \case
Just ct' | not (contactDeleted ct') -> pure (con cReq, CPContactAddress (CAPContactViaAddress ct'))
_ -> do
contactSLinkData_ <- liftIO $ decodeLinkUserData cData
@@ -4133,9 +4133,9 @@ processChatCommand vr nm = \case
liftIO (getUserContactLinkViaShortLink db user l') >>= \case
Just UserContactLink {connLinkContact = CCLink cReq _} -> pure $ Just (con cReq, CPContactAddress CAPOwnLink)
Nothing ->
- getContactViaShortLinkToConnect db vr user l' >>= \case
+ getContactViaShortLinkToConnect db cxt user l' >>= \case
Just (cReq, ct') -> pure $ if contactDeleted ct' then Nothing else Just (con cReq, CPContactAddress (CAPKnown ct'))
- Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db vr user l'
+ Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db cxt user l'
CCTGroup -> groupShortLinkPlan
CCTChannel -> groupShortLinkPlan
CCTRelay -> throwCmdError "chat relay links are not supported in this version"
@@ -4171,9 +4171,9 @@ processChatCommand vr nm = \case
Just GroupShortLinkData {groupProfile = GroupProfile {publicGroup = Just PublicGroupProfile {groupType}}} -> groupType /= GTChannel
_ -> False
knownLinkPlans = withFastStore $ \db ->
- liftIO (getGroupInfoViaUserShortLink db vr user l') >>= \case
+ liftIO (getGroupInfoViaUserShortLink db cxt user l') >>= \case
Just (cReq, g) -> pure $ Just (con cReq, CPGroupLink (GLPOwnLink g))
- Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db vr user l'
+ Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db cxt user l'
resolveKnownGroup g = do
(fd@FixedLinkData {rootKey = rk}, cData@(ContactLinkData _ UserContactData {owners})) <- getShortLinkConnReq' nm user l'
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
@@ -4189,13 +4189,13 @@ processChatCommand vr nm = \case
case plan of CPError e -> eToView e; _ -> pure ()
case plan of
CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
- processChatCommand vr nm $ APIConnectContactViaAddress userId incognito contactId
- _ -> processChatCommand vr nm $ APIConnect userId incognito $ Just ccLink
+ processChatCommand cxt nm $ APIConnectContactViaAddress userId incognito contactId
+ _ -> processChatCommand cxt nm $ APIConnect userId incognito $ Just ccLink
| otherwise = pure $ CRConnectionPlan user ccLink plan
invitationRequestPlan :: User -> ConnReqInvitation -> Maybe ContactShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
invitationRequestPlan user cReq cld ov = do
maybe (CPInvitationLink (ILPOk cld ov)) (invitationEntityPlan cld ov)
- <$> withFastStore' (\db -> getConnectionEntityByConnReq db vr user $ invCReqSchemas cReq)
+ <$> withFastStore' (\db -> getConnectionEntityByConnReq db cxt user $ invCReqSchemas cReq)
where
invCReqSchemas :: ConnReqInvitation -> (ConnReqInvitation, ConnReqInvitation)
invCReqSchemas (CRInvitationUri crData e2e) =
@@ -4227,9 +4227,9 @@ processChatCommand vr nm = \case
withFastStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case
Just _ -> pure $ CPContactAddress CAPOwnLink
Nothing ->
- withFastStore' (\db -> getContactConnEntityByConnReqHash db vr user cReqHashes) >>= \case
+ withFastStore' (\db -> getContactConnEntityByConnReqHash db cxt user cReqHashes) >>= \case
Nothing ->
- withFastStore' (\db -> getContactWithoutConnViaAddress db vr user cReqSchemas) >>= \case
+ withFastStore' (\db -> getContactWithoutConnViaAddress db cxt user cReqSchemas) >>= \case
Just ct | not (contactDeleted ct) -> pure $ CPContactAddress (CAPContactViaAddress ct)
_ -> pure $ CPContactAddress (CAPOk cld ov)
Just (RcvDirectMsgConnection Connection {connStatus} Nothing)
@@ -4246,11 +4246,11 @@ processChatCommand vr nm = \case
groupJoinRequestPlan user (CRContactUri crData) linkInfo gld ov = do
let cReqSchemas = contactCReqSchemas crData
cReqHashes = bimap contactCReqHash contactCReqHash cReqSchemas
- withFastStore' (\db -> getGroupInfoByUserContactLinkConnReq db vr user cReqSchemas) >>= \case
+ withFastStore' (\db -> getGroupInfoByUserContactLinkConnReq db cxt user cReqSchemas) >>= \case
Just g -> pure $ CPGroupLink (GLPOwnLink g)
Nothing -> do
- connEnt_ <- withFastStore' $ \db -> getContactConnEntityByConnReqHash db vr user cReqHashes
- gInfo_ <- withFastStore' $ \db -> getGroupInfoByGroupLinkHash db vr user cReqHashes
+ connEnt_ <- withFastStore' $ \db -> getContactConnEntityByConnReqHash db cxt user cReqHashes
+ gInfo_ <- withFastStore' $ \db -> getGroupInfoByGroupLinkHash db cxt user cReqHashes
case (gInfo_, connEnt_) of
(Nothing, Nothing) -> pure $ CPGroupLink (GLPOk linkInfo gld ov)
-- TODO [short links] RcvDirectMsgConnection branches are deprecated? (old group link protocol?)
@@ -4305,7 +4305,7 @@ processChatCommand vr nm = \case
shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId' conn) SCMInvitation userLinkData Nothing)
updateCIGroupInvitationStatus :: User -> GroupInfo -> CIGroupInvitationStatus -> CM ()
updateCIGroupInvitationStatus user GroupInfo {groupId} newStatus = do
- AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db vr user groupId
+ AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db cxt user groupId
case (cInfo, content) of
(DirectChat ct@Contact {contactId}, CIRcvGroupInvitation ciGroupInv@CIGroupInvitation {status} memRole)
| status == CIGISPending -> do
@@ -4328,7 +4328,7 @@ processChatCommand vr nm = \case
sendContactContentMessages :: User -> ContactId -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
sendContactContentMessages user contactId live itemTTL cmrs = do
assertMultiSendable live cmrs
- ct <- withFastStore $ \db -> getContact db vr user contactId
+ ct <- withFastStore $ \db -> getContact db cxt user contactId
assertDirectAllowed user MDSnd ct XMsgNew_
assertVoiceAllowed ct
processComposedMessages ct
@@ -4385,8 +4385,8 @@ processChatCommand vr nm = \case
sendGroupContentMessages :: User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
sendGroupContentMessages user gInfo scope showGroupAsSender live itemTTL cmrs = do
assertMultiSendable live cmrs
- chatScopeInfo <- mapM (getChatScopeInfo vr user) scope
- recipients <- getGroupRecipients vr user gInfo chatScopeInfo modsCompatVersion
+ chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope
+ recipients <- getGroupRecipients cxt user gInfo chatScopeInfo modsCompatVersion
sendGroupContentMessages_ user gInfo scope showGroupAsSender chatScopeInfo recipients live itemTTL cmrs
where
hasReport = any (\(ComposedMessage {msgContent}, _, _, _) -> isReport msgContent) cmrs
@@ -4531,7 +4531,7 @@ processChatCommand vr nm = \case
throwError err
getCommandDirectChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (Contact, [CChatItem 'CTDirect])
getCommandDirectChatItems user ctId itemIds = do
- ct <- withFastStore $ \db -> getContact db vr user ctId
+ ct <- withFastStore $ \db -> getContact db cxt user ctId
(errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getDirectCI db) (L.toList itemIds))
unless (null errs) $ toView $ CEvtChatErrors errs
pure (ct, items)
@@ -4540,7 +4540,7 @@ processChatCommand vr nm = \case
getDirectCI db itemId = runExceptT . withExceptT ChatErrorStore $ getDirectChatItem db user ctId itemId
getCommandGroupChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (GroupInfo, [CChatItem 'CTGroup])
getCommandGroupChatItems user gId itemIds = do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user gId
(errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db gInfo) (L.toList itemIds))
unless (null errs) $ toView $ CEvtChatErrors errs
pure (gInfo, items)
@@ -4599,7 +4599,7 @@ processChatCommand vr nm = \case
withSendRef user chatRef a = case chatRef of
ChatRef CTDirect cId _ -> a $ SRDirect cId
ChatRef CTGroup gId scope -> do
- gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
+ gInfo <- withFastStore $ \db -> getGroupInfo db cxt user gId
a $ SRGroup gId scope (sendAsGroup' gInfo scope)
_ -> throwCmdError "not supported"
getSharedMsgId :: CM SharedMsgId
@@ -4792,17 +4792,17 @@ cleanupManager = do
timedItems <- withStore' $ \db -> getTimedItems db user startTimedThreadCutoff
forM_ timedItems $ \(itemRef, deleteAt) -> startTimedItemThread user itemRef deleteAt `catchAllErrors` const (pure ())
cleanupDeletedContacts user = do
- vr <- chatVersionRange
- contacts <- withStore' $ \db -> getDeletedContacts db vr user
+ cxt <- chatStoreCxt
+ contacts <- withStore' $ \db -> getDeletedContacts db cxt user
forM_ contacts $ \ct ->
withStore (\db -> deleteContactWithoutGroups db user ct)
`catchAllErrors` eToView
cleanupInProgressGroups user = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
ts <- liftIO getCurrentTime
-- older than 30 minutes to avoid deleting a newly created group
let cutoffTs = addUTCTime (- 1800) ts
- inProgressGroups <- withStore' $ \db -> getInProgressGroups db vr user cutoffTs
+ inProgressGroups <- withStore' $ \db -> getInProgressGroups db cxt user cutoffTs
forM_ inProgressGroups $ \gInfo ->
deleteInProgressGroup user gInfo `catchAllErrors` eToView
cleanupStaleRelayTestConns user = do
@@ -4813,10 +4813,10 @@ cleanupManager = do
deleteAgentConnectionAsync acId
withStore' $ \db -> deleteConnectionByAgentConnId db user acId
cleanupRemovedMembers user = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
ts <- liftIO getCurrentTime
let cutoffTs = addUTCTime (-nominalDay) ts
- removedMembers <- withStore' $ \db -> getRemovedMembersToCleanup db vr user cutoffTs
+ removedMembers <- withStore' $ \db -> getRemovedMembersToCleanup db cxt user cutoffTs
forM_ removedMembers $ \m ->
withStore' (\db -> deleteGroupMember db user m) `catchAllErrors` eToView
cleanupMessages = do
@@ -4854,8 +4854,8 @@ runRelayGroupLinkChecks user = do
liftIO $ threadDelay' $ diffToMicroseconds interval
where
checkRelayServedGroups = do
- vr <- chatVersionRange
- relayGroups <- withStore' $ \db -> getRelayServedGroups db vr user
+ cxt <- chatStoreCxt
+ relayGroups <- withStore' $ \db -> getRelayServedGroups db cxt user
forM_ relayGroups $ \gInfo@GroupInfo {groupProfile = gp} -> flip catchAllErrors eToView $ do
case publicGroup gp of
Just PublicGroupProfile {groupLink = sLnk} -> do
@@ -4873,24 +4873,24 @@ runRelayGroupLinkChecks user = do
_ -> pure ()
_ -> pure ()
checkRelayInactiveGroups = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
ttl <- asks (relayInactiveTTL . config)
- inactiveGroups <- withStore' $ \db -> getRelayInactiveGroups db vr user ttl
+ inactiveGroups <- withStore' $ \db -> getRelayInactiveGroups db cxt user ttl
forM_ inactiveGroups $ \gInfo -> flip catchAllErrors eToView $
deleteGroupConnections user gInfo False
expireChatItems :: User -> Int64 -> Bool -> CM ()
expireChatItems user@User {userId} globalTTL sync = do
currentTs <- liftIO getCurrentTime
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
-- this is to keep group messages created during last 12 hours even if they're expired according to item_ts
let createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs
lift waitChatStartedAndActivated
contactIds <- withStore' $ \db -> getUserContactsToExpire db user globalTTL
- loop contactIds $ expireContactChatItems user vr globalTTL
+ loop contactIds $ expireContactChatItems user cxt globalTTL
lift waitChatStartedAndActivated
groupIds <- withStore' $ \db -> getUserGroupsToExpire db user globalTTL
- loop groupIds $ expireGroupChatItems user vr globalTTL createdAtCutoff
+ loop groupIds $ expireGroupChatItems user cxt globalTTL createdAtCutoff
where
loop :: [Int64] -> (Int64 -> CM ()) -> CM ()
loop [] _ = pure ()
@@ -4906,11 +4906,11 @@ expireChatItems user@User {userId} globalTTL sync = do
expire <- atomically $ TM.lookup userId expireFlags
when (expire == Just True) $ threadDelay 100000 >> a
-expireContactChatItems :: User -> VersionRangeChat -> Int64 -> ContactId -> CM ()
-expireContactChatItems user vr globalTTL ctId =
+expireContactChatItems :: User -> StoreCxt -> Int64 -> ContactId -> CM ()
+expireContactChatItems user cxt globalTTL ctId =
-- reading contacts and groups inside the loop,
-- to allow ttl changing while processing and to reduce memory usage
- tryAllErrors (withStore $ \db -> getContact db vr user ctId) >>= mapM_ process
+ tryAllErrors (withStore $ \db -> getContact db cxt user ctId) >>= mapM_ process
where
process ct@Contact {chatItemTTL} =
withExpirationDate globalTTL chatItemTTL $ \expirationDate -> do
@@ -4919,9 +4919,9 @@ expireContactChatItems user vr globalTTL ctId =
deleteCIFiles user filesInfo
withStore' $ \db -> deleteContactExpiredCIs db user ct expirationDate
-expireGroupChatItems :: User -> VersionRangeChat -> Int64 -> UTCTime -> GroupId -> CM ()
-expireGroupChatItems user vr globalTTL createdAtCutoff groupId =
- tryAllErrors (withStore $ \db -> getGroupInfo db vr user groupId) >>= mapM_ process
+expireGroupChatItems :: User -> StoreCxt -> Int64 -> UTCTime -> GroupId -> CM ()
+expireGroupChatItems user cxt globalTTL createdAtCutoff groupId =
+ tryAllErrors (withStore $ \db -> getGroupInfo db cxt user groupId) >>= mapM_ process
where
process gInfo@GroupInfo {chatItemTTL} =
withExpirationDate globalTTL chatItemTTL $ \expirationDate -> do
@@ -4929,7 +4929,7 @@ expireGroupChatItems user vr globalTTL createdAtCutoff groupId =
filesInfo <- withStore' $ \db -> getGroupExpiredFileInfo db user gInfo expirationDate createdAtCutoff
deleteCIFiles user filesInfo
withStore' $ \db -> deleteGroupExpiredCIs db user gInfo expirationDate createdAtCutoff
- membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db vr user gInfo
+ membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db cxt user gInfo
forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m
withExpirationDate :: Int64 -> Maybe Int64 -> (UTCTime -> CM ()) -> CM ()
diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs
index d25645858f..57cabfb90d 100644
--- a/src/Simplex/Chat/Library/Internal.hs
+++ b/src/Simplex/Chat/Library/Internal.hs
@@ -473,12 +473,12 @@ deleteGroupCIs user gInfo chatScopeInfo items byGroupMember_ deletedTs = do
deleteCIFiles user ciFilesInfo
(errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items)
unless (null errs) $ toView $ CEvtChatErrors errs
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
deletions' <- case chatScopeInfo of
Nothing -> pure deletions
Just scopeInfo@GCSIMemberSupport {groupMember_} -> do
let decStats = countDeletedUnreadItems groupMember_ deletions
- gInfo' <- withFastStore' $ \db -> updateGroupScopeUnreadStats db vr user gInfo scopeInfo decStats
+ gInfo' <- withFastStore' $ \db -> updateGroupScopeUnreadStats db cxt user gInfo scopeInfo decStats
pure $ map (updateDeletionGroupInfo gInfo') deletions
pure deletions'
where
@@ -687,7 +687,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
unless (fileStatus == RFSNew) $ case fileStatus of
RFSCancelled _ -> throwChatError $ CEFileCancelled fName
_ -> throwChatError $ CEFileAlreadyReceiving fName
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
case (xftpRcvFile, fileConnReq) of
-- XFTP
(Just XFTPRcvFile {userApprovedRelays = approvedBeforeReady}, _) -> do
@@ -696,7 +696,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
(ci, rfd) <- withStore $ \db -> do
-- marking file as accepted and reading description in the same transaction
-- to prevent race condition with appending description
- ci <- xftpAcceptRcvFT db vr user fileId filePath userApproved
+ ci <- xftpAcceptRcvFT db cxt user fileId filePath userApproved
rfd <- getRcvFileDescrByRcvFileId db fileId
pure (ci, rfd)
receiveViaCompleteFD user fileId rfd userApproved cryptoArgs
@@ -707,10 +707,10 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
chatRef <- withStore $ \db -> getChatRefByFileId db user fileId
case (chatRef, grpMemberId) of
(ChatRef CTDirect contactId _, Nothing) -> do
- ct <- withStore $ \db -> getContact db vr user contactId
+ ct <- withStore $ \db -> getContact db cxt user contactId
acceptFile $ \msg -> void $ sendDirectContactMessage user ct msg
(ChatRef CTGroup groupId _, Just memId) -> do
- GroupMember {activeConn} <- withStore $ \db -> getGroupMember db vr user groupId memId
+ GroupMember {activeConn} <- withStore $ \db -> getGroupMember db cxt user groupId memId
case activeConn of
Just conn -> do
acceptFile $ \msg -> void $ sendDirectMemberMessage conn msg groupId
@@ -721,12 +721,12 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
acceptFile send = do
filePath <- getRcvFilePath fileId filePath_ fName True
inline <- receiveInline
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
if
| inline -> do
-- accepting inline
(ci, sharedMsgId) <- withStore $ \db ->
- liftM2 (,) (acceptRcvInlineFT db vr user fileId filePath) (getSharedMsgIdByFileId db userId fileId)
+ liftM2 (,) (acceptRcvInlineFT db cxt user fileId filePath) (getSharedMsgIdByFileId db userId fileId)
send $ XFileAcptInv sharedMsgId Nothing fName
pure ci
| fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName
@@ -802,13 +802,13 @@ getNetworkConfig = withAgent' $ liftIO . getFastNetworkConfig
resetRcvCIFileStatus :: User -> FileTransferId -> CIFileStatus 'MDRcv -> CM (Maybe AChatItem)
resetRcvCIFileStatus user fileId ciFileStatus = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
withStore $ \db -> do
liftIO $ do
updateCIFileStatus db user fileId ciFileStatus
updateRcvFileStatus db fileId FSNew
updateRcvFileAgentId db fileId Nothing
- lookupChatItemByFileId db vr user fileId
+ lookupChatItemByFileId db cxt user fileId
receiveViaURI :: User -> FileDescriptionURI -> CryptoFile -> CM RcvFileTransfer
receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile {cryptoArgs} = do
@@ -826,11 +826,11 @@ receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile
startReceivingFile :: User -> FileTransferId -> CM ()
startReceivingFile user fileId = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
ci <- withStore $ \db -> do
liftIO $ updateRcvFileStatus db fileId FSConnected
liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
- getChatItemByFileId db vr user fileId
+ getChatItemByFileId db cxt user fileId
toView $ CEvtRcvFileStart user ci
getRcvFilePath :: FileTransferId -> Maybe FilePath -> String -> Bool -> CM FilePath
@@ -881,8 +881,8 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId
subMode <- chatReadVar subscriptionMode
let pqSup = PQSupportOn
pqSup' = pqSup `CR.pqSupportAnd` pqSupport
- vr <- chatVersionRange
- let chatV = vr `peerConnChatVersion` cReqChatVRange
+ cxt <- chatStoreCxt
+ let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
(ct, conn, incognitoProfile) <- case contactId_ of
Nothing -> do
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
@@ -891,7 +891,7 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId
createContactFromRequest db user userContactLinkId_ connId chatV cReqChatVRange cName profileId cp xContactId incognitoProfile subMode pqSup' False
pure (ct, conn, incognitoProfile)
Just contactId -> do
- ct <- withFastStore $ \db -> getContact db vr user contactId
+ ct <- withFastStore $ \db -> getContact db cxt user contactId
case contactConn ct of
Nothing -> do
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
@@ -917,15 +917,15 @@ acceptContactRequestAsync
incognitoProfile = do
subMode <- chatReadVar subscriptionMode
let profileToSend = userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
- vr <- chatVersionRange
- let chatV = vr `peerConnChatVersion` cReqChatVRange
+ cxt <- chatStoreCxt
+ let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
(cmdId, acId) <- agentAcceptContactAsync user True cReqInvId (XInfo profileToSend) subMode cReqPQSup chatV
currentTs <- liftIO getCurrentTime
withStore $ \db -> do
forM_ xContactId $ \xcId -> liftIO $ setContactAcceptedXContactId db ct xcId
Connection {connId} <- liftIO $ createAcceptedContactConn db user (Just uclId) contactId acId chatV cReqChatVRange cReqPQSup incognitoProfile subMode currentTs
liftIO $ setCommandConnId db user cmdId connId
- getContact db vr user contactId
+ getContact db cxt user contactId
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember
acceptGroupJoinRequestAsync
@@ -968,12 +968,12 @@ acceptGroupJoinRequestAsync
groupSize = Just currentMemCount
}
subMode <- chatReadVar subscriptionMode
- vr <- chatVersionRange
- let chatV = vr `peerConnChatVersion` cReqChatVRange
+ cxt <- chatStoreCxt
+ let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
withStore $ \db -> do
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
- getGroupMemberById db vr user groupMemberId
+ getGroupMemberById db cxt user groupMemberId
acceptGroupJoinSendRejectAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> GroupRejectionReason -> CM GroupMember
acceptGroupJoinSendRejectAsync
@@ -998,12 +998,12 @@ acceptGroupJoinSendRejectAsync
rejectionReason
}
subMode <- chatReadVar subscriptionMode
- vr <- chatVersionRange
- let chatV = vr `peerConnChatVersion` cReqChatVRange
+ cxt <- chatStoreCxt
+ let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user False cReqInvId msg subMode PQSupportOff chatV
withStore $ \db -> do
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
- getGroupMemberById db vr user groupMemberId
+ getGroupMemberById db cxt user groupMemberId
acceptBusinessJoinRequestAsync :: User -> Int64 -> GroupInfo -> GroupMember -> UserContactRequest -> CM (GroupInfo, GroupMember)
acceptBusinessJoinRequestAsync
@@ -1012,7 +1012,7 @@ acceptBusinessJoinRequestAsync
gInfo@GroupInfo {membership = GroupMember {memberRole = userRole, memberId = userMemberId}}
clientMember@GroupMember {groupMemberId, memberId}
UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange, xContactId} = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
let userProfile@Profile {displayName, preferences} = fromLocalProfile $ profile' user
-- TODO [short links] take groupPreferences from group info
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences
@@ -1031,7 +1031,7 @@ acceptBusinessJoinRequestAsync
groupSize = Just 1
}
subMode <- chatReadVar subscriptionMode
- let chatV = vr `peerConnChatVersion` cReqChatVRange
+ let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
withStore' $ \db -> do
forM_ xContactId $ \xcId -> setBusinessChatAcceptedXContactId db gInfo xcId
@@ -1055,28 +1055,28 @@ acceptRelayJoinRequestAsync
-- TODO [channel web] derive RelayCapabilities from relay config (RelayWebOptions)
let msg = XGrpRelayAcpt relayLink defaultRelayCapabilities
subMode <- chatReadVar subscriptionMode
- vr <- chatVersionRange
- let chatV = vr `peerConnChatVersion` cReqChatVRange
+ cxt <- chatStoreCxt
+ let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
withStore $ \db -> do
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
gInfo' <- liftIO $ updateRelayOwnStatusFromTo db gInfo RSInvited RSAccepted
- ownerMember' <- getGroupMemberById db vr user groupMemberId
+ ownerMember' <- getGroupMemberById db cxt user groupMemberId
pure (gInfo', ownerMember')
rejectRelayInvitationAsync
:: User
-> Int64
- -> VersionRangeChat
+ -> StoreCxt
-> GroupRelayInvitation
-> InvitationId
-> VersionRangeChat
-> Int64
-> RelayRejectionReason
-> CM ()
-rejectRelayInvitationAsync user uclId vr groupRelayInv invId reqChatVRange initialDelay reason = do
+rejectRelayInvitationAsync user uclId cxt groupRelayInv invId reqChatVRange initialDelay reason = do
(_gInfo, ownerMember) <- withStore $ \db ->
- createRelayRequestGroup db vr user groupRelayInv invId reqChatVRange initialDelay GSMemInvited RSRejected
+ createRelayRequestGroup db cxt user groupRelayInv invId reqChatVRange initialDelay GSMemInvited RSRejected
let GroupMember {groupMemberId} = ownerMember
msg = XGrpRelayReject reason
subMode <- chatReadVar subscriptionMode
@@ -1090,15 +1090,15 @@ businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile
businessGroupProfile Profile {displayName, fullName, shortDescr, image} groupPreferences =
GroupProfile {displayName, fullName, description = Nothing, shortDescr, image, publicGroup = Nothing, groupPreferences = Just groupPreferences, memberAdmission = Nothing}
-introduceToModerators :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
-introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRole, memberId} = do
+introduceToModerators :: StoreCxt -> User -> GroupInfo -> GroupMember -> CM ()
+introduceToModerators cxt user gInfo@GroupInfo {groupId} m@GroupMember {memberRole, memberId} = do
forM_ (memberConn m) $ \mConn -> do
let msg =
if maxVersion (memberChatVRange m) >= groupKnockingVersion
then XGrpLinkAcpt GAPendingReview memberRole memberId
else XMsgNew $ mcSimple (MCText pendingReviewMessage)
void $ sendDirectMemberMessage mConn msg groupId
- modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
+ modMs <- withStore' $ \db -> getGroupModerators db cxt user gInfo
let rcpModMs = filter shouldIntroduceToMod modMs
introduceMember user gInfo m rcpModMs (Just $ MSMember $ memberId' m)
where
@@ -1108,15 +1108,15 @@ introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRol
&& groupMemberId' mem /= groupMemberId' m
&& maxVersion (memberChatVRange mem) >= groupKnockingVersion
-introduceToAll :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
-introduceToAll vr user gInfo m = do
- (members, vector) <- withStore $ \db -> liftM2 (,) (liftIO $ getGroupMembers db vr user gInfo) (getMemberRelationsVector db m)
+introduceToAll :: StoreCxt -> User -> GroupInfo -> GroupMember -> CM ()
+introduceToAll cxt user gInfo m = do
+ (members, vector) <- withStore $ \db -> liftM2 (,) (liftIO $ getGroupMembers db cxt user gInfo) (getMemberRelationsVector db m)
let recipients = filter (shouldIntroduce m vector) members
introduceMember user gInfo m recipients Nothing
-introduceToRemaining :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
-introduceToRemaining vr user gInfo m = do
- (members, vector) <- withStore $ \db -> liftM2 (,) (liftIO $ getGroupMembers db vr user gInfo) (getMemberRelationsVector db m)
+introduceToRemaining :: StoreCxt -> User -> GroupInfo -> GroupMember -> CM ()
+introduceToRemaining cxt user gInfo m = do
+ (members, vector) <- withStore $ \db -> liftM2 (,) (liftIO $ getGroupMembers db cxt user gInfo) (getMemberRelationsVector db m)
let recipients = filter (shouldIntroduce m vector) members
introduceMember user gInfo m recipients Nothing
@@ -1171,12 +1171,12 @@ memberIntroEvt gInfo reMember =
-- sent it, so the recipient verifies the owner signature.
forwardGroupRoster :: User -> GroupInfo -> GroupMember -> CM ()
forwardGroupRoster user gInfo subscriber = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
withStore' (\db -> getGroupRoster db gInfo) >>= \case
Nothing -> pure ()
Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}) ->
forM_ (eitherToMaybe (J.eitherDecodeStrict' signedBody) :: Maybe (ChatMessage 'Json)) $ \chatMsg ->
- withStore' (\db -> runExceptT $ getGroupMemberById db vr user ownerGMId) >>= \case
+ withStore' (\db -> runExceptT $ getGroupMemberById db cxt user ownerGMId) >>= \case
Right owner -> do
let fwd = GrpMsgForward {fwdSender = FwdMember (memberId' owner) (memberShortenedName owner), fwdBrokerTs = brokerTs}
sendFwdMemberMessage subscriber fwd (VMSigned MSSVerified sm chatMsg)
@@ -1185,11 +1185,11 @@ forwardGroupRoster user gInfo subscriber = do
-- Used in groups with relays to introduce moderators and above to a new member,
-- and to announce the new member to moderators and above.
-- This doesn't create introduction records in db, compared to above methods.
-introduceInChannel :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
+introduceInChannel :: StoreCxt -> User -> GroupInfo -> GroupMember -> CM ()
introduceInChannel _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
-introduceInChannel vr user gInfo subscriber@GroupMember {activeConn = Just conn, indexInGroup = subscriberIdx} = do
+introduceInChannel cxt user gInfo subscriber@GroupMember {activeConn = Just conn, indexInGroup = subscriberIdx} = do
(owners, rosterMems) <- withStore' $ \db ->
- (,) <$> getGroupOwners db vr user gInfo <*> getGroupRosterMembers db vr user gInfo
+ (,) <$> getGroupOwners db cxt user gInfo <*> getGroupRosterMembers db cxt user gInfo
let modMs = owners <> rosterMems
void $ sendGroupMessage' user gInfo modMs $ XGrpMemNew (memberInfo gInfo subscriber) Nothing
withStore' $ \db ->
@@ -1379,9 +1379,9 @@ setGroupLinkData' nm user gInfo =
setGroupLinkData :: NetworkRequestMode -> User -> GroupInfo -> GroupLink -> CM GroupLink
setGroupLinkData nm user gInfo gLink = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
(conn, groupRelays) <- withFastStore $ \db ->
- (,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
+ (,) <$> getGroupLinkConnection db cxt user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
linkType = if useRelays' gInfo then CCTChannel else CCTGroup
sLnk <- shortenShortLink' . setShortLinkType_ linkType =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData (Just crClientData))
@@ -1389,17 +1389,17 @@ setGroupLinkData nm user gInfo gLink = do
setGroupLinkDataAsync :: User -> GroupInfo -> GroupLink -> CM ()
setGroupLinkDataAsync user gInfo gLink = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
(conn, groupRelays) <- withStore $ \db ->
- (,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
+ (,) <$> getGroupLinkConnection db cxt user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
setAgentConnShortLinkAsync user conn userLinkData (Just crClientData)
connectToRelayAsync :: User -> GroupInfo -> ShortLinkContact -> CM ()
connectToRelayAsync user gInfo relayLink = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
gVar <- asks random
- relayMember@GroupMember {activeConn} <- withFastStore $ \db -> getCreateRelayForMember db vr gVar user gInfo relayLink
+ relayMember@GroupMember {activeConn} <- withFastStore $ \db -> getCreateRelayForMember db cxt gVar user gInfo relayLink
case activeConn of
Just _ -> pure ()
Nothing -> do
@@ -1410,9 +1410,9 @@ connectToRelayAsync user gInfo relayLink = do
updatePublicGroupData :: User -> GroupInfo -> CM GroupInfo
updatePublicGroupData user gInfo
| useRelays' gInfo && memberRole' (membership gInfo) == GROwner = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
(gInfo', gLink) <- withStore $ \db -> do
- gInfo' <- updatePublicMemberCount db vr user gInfo
+ gInfo' <- updatePublicMemberCount db cxt user gInfo
gLink <- getGroupLink db user gInfo'
pure (gInfo', gLink)
setGroupLinkDataAsync user gInfo' gLink
@@ -1422,12 +1422,12 @@ updatePublicGroupData user gInfo
updateGroupFromLinkData :: User -> GroupInfo -> GroupShortLinkData -> CM (GroupInfo, Bool)
updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupSummary = GroupSummary {publicMemberCount = localCount}} GroupShortLinkData {groupProfile, publicGroupData}
| profileChanged || countChanged = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
withStore $ \db -> do
g <- if profileChanged then updateGroupProfile db user gInfo groupProfile else pure gInfo
g' <- case publicGroupData of
Just PublicGroupData {publicMemberCount} | countChanged ->
- setPublicMemberCount db vr user g publicMemberCount
+ setPublicMemberCount db cxt user g publicMemberCount
_ -> pure g
pure (g', profileChanged)
| otherwise = pure (gInfo, False)
@@ -1506,14 +1506,14 @@ shortenCreatedLink (CCLink cReq sLnk) = CCLink cReq <$> mapM shortenShortLink' s
deleteGroupLink' :: User -> GroupInfo -> CM ()
deleteGroupLink' user gInfo = do
- vr <- chatVersionRange
- conn <- withStore $ \db -> getGroupLinkConnection db vr user gInfo
+ cxt <- chatStoreCxt
+ conn <- withStore $ \db -> getGroupLinkConnection db cxt user gInfo
deleteGroupLink_ user gInfo conn
deleteGroupLinkIfExists :: User -> GroupInfo -> CM ()
deleteGroupLinkIfExists user gInfo = do
- vr <- chatVersionRange
- conn_ <- eitherToMaybe <$> withStore' (\db -> runExceptT $ getGroupLinkConnection db vr user gInfo)
+ cxt <- chatStoreCxt
+ conn_ <- eitherToMaybe <$> withStore' (\db -> runExceptT $ getGroupLinkConnection db cxt user gInfo)
mapM_ (deleteGroupLink_ user gInfo) conn_
deleteGroupLink_ :: User -> GroupInfo -> Connection -> CM ()
@@ -1548,16 +1548,16 @@ deleteTimedItem user (ChatRef cType chatId scope, itemId) deleteAt = do
ts <- liftIO getCurrentTime
liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime deleteAt ts
lift waitChatStartedAndActivated
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
case cType of
CTDirect -> do
- (ct, ci) <- withStore $ \db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId
+ (ct, ci) <- withStore $ \db -> (,) <$> getContact db cxt user chatId <*> getDirectChatItem db user chatId itemId
deletions <- deleteDirectCIs user ct [ci]
toView $ CEvtChatItemsDeleted user deletions True True
CTGroup -> do
- (gInfo, ci) <- withStore $ \db -> (,) <$> getGroupInfo db vr user chatId <*> getGroupChatItem db user chatId itemId
+ (gInfo, ci) <- withStore $ \db -> (,) <$> getGroupInfo db cxt user chatId <*> getGroupChatItem db user chatId itemId
deletedTs <- liftIO getCurrentTime
- chatScopeInfo <- mapM (getChatScopeInfo vr user) scope
+ chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope
deletions <- deleteGroupCIs user gInfo chatScopeInfo [ci] Nothing deletedTs
toView $ CEvtChatItemsDeleted user deletions True True
_ -> eToView $ ChatError $ CEInternalError "bad deleteTimedItem cType"
@@ -1677,25 +1677,25 @@ parseChatMessage' conn s =
where
errType = CEInvalidChatMessage conn Nothing (safeDecodeUtf8 s)
-getChatScopeInfo :: VersionRangeChat -> User -> GroupChatScope -> CM GroupChatScopeInfo
-getChatScopeInfo vr user = \case
+getChatScopeInfo :: StoreCxt -> User -> GroupChatScope -> CM GroupChatScopeInfo
+getChatScopeInfo cxt user = \case
GCSMemberSupport Nothing -> pure $ GCSIMemberSupport Nothing
GCSMemberSupport (Just gmId) -> do
- supportMem <- withFastStore $ \db -> getGroupMemberById db vr user gmId
+ supportMem <- withFastStore $ \db -> getGroupMemberById db cxt user gmId
pure $ GCSIMemberSupport (Just supportMem)
-getGroupRecipients :: VersionRangeChat -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> VersionChat -> CM [GroupMember]
-getGroupRecipients vr user gInfo@GroupInfo {membership} scopeInfo modsCompatVersion
+getGroupRecipients :: StoreCxt -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> VersionChat -> CM [GroupMember]
+getGroupRecipients cxt user gInfo@GroupInfo {membership} scopeInfo modsCompatVersion
| useRelays' gInfo && not (isRelay membership) = do
unless (memberCurrent membership && memberActive membership) $ throwChatError $ CECommandError "not current member"
- withFastStore' $ \db -> getGroupRelayMembers db vr user gInfo
+ withFastStore' $ \db -> getGroupRelayMembers db cxt user gInfo
| otherwise = case scopeInfo of
Nothing -> do
unless (memberCurrent membership && memberActive membership) $ throwChatError $ CECommandError "not current member"
- ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
+ ms <- withFastStore' $ \db -> getGroupMembers db cxt user gInfo
pure $ filter memberCurrent ms
Just (GCSIMemberSupport Nothing) -> do
- modMs <- withFastStore' $ \db -> getGroupModerators db vr user gInfo
+ modMs <- withFastStore' $ \db -> getGroupModerators db cxt user gInfo
let rcpModMs' = filter (\m -> compatible m && memberCurrent m) modMs
when (null rcpModMs') $ throwChatError $ CECommandError "no admins support this message"
pure rcpModMs'
@@ -1705,7 +1705,7 @@ getGroupRecipients vr user gInfo@GroupInfo {membership} scopeInfo modsCompatVers
if memberStatus supportMem == GSMemPendingApproval
then pure [supportMem]
else do
- modMs <- withFastStore' $ \db -> getGroupModerators db vr user gInfo
+ modMs <- withFastStore' $ \db -> getGroupModerators db cxt user gInfo
let rcpModMs' = filter (\m -> compatible m && memberCurrent m) modMs
pure $ [supportMem] <> rcpModMs'
where
@@ -1731,8 +1731,8 @@ mkGroupChatScope gInfo@GroupInfo {membership} m
| otherwise =
pure (gInfo, m, Nothing)
-mkGetMessageChatScope :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> MsgContent -> Maybe MsgScope -> CM (GroupInfo, GroupMember, Maybe GroupChatScopeInfo)
-mkGetMessageChatScope vr user gInfo@GroupInfo {membership} m mc msgScope_ =
+mkGetMessageChatScope :: StoreCxt -> User -> GroupInfo -> GroupMember -> MsgContent -> Maybe MsgScope -> CM (GroupInfo, GroupMember, Maybe GroupChatScopeInfo)
+mkGetMessageChatScope cxt user gInfo@GroupInfo {membership} m mc msgScope_ =
mkGroupChatScope gInfo m >>= \case
groupScope@(_gInfo', _m', Just _scopeInfo) -> pure groupScope
(_, _, Nothing)
@@ -1747,7 +1747,7 @@ mkGetMessageChatScope vr user gInfo@GroupInfo {membership} m mc msgScope_ =
(gInfo', scopeInfo) <- mkGroupSupportChatInfo gInfo
pure (gInfo', m, Just scopeInfo)
| otherwise -> do
- referredMember <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo mId
+ referredMember <- withStore $ \db -> getGroupMemberByMemberId db cxt user gInfo mId
-- TODO [knocking] return patched _referredMember'?
(_referredMember', scopeInfo) <- mkMemberSupportChatInfo referredMember
pure (gInfo, m, Just scopeInfo)
@@ -1861,8 +1861,8 @@ cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, fil
withStore' $ \db -> updateSndFileStatus db ft FSCancelled
when sendCancel $ case fileInline of
Just _ -> do
- vr <- chatVersionRange
- (sharedMsgId, conn) <- withStore $ \db -> (,) <$> getSharedMsgIdByFileId db userId fileId <*> getConnectionById db vr user connId
+ cxt <- chatStoreCxt
+ (sharedMsgId, conn) <- withStore $ \db -> (,) <$> getSharedMsgIdByFileId db userId fileId <*> getConnectionById db cxt user connId
void $ sendDirectMessage_ conn (BFileChunk sharedMsgId FileChunkCancel) (ConnectionId connId)
_ -> throwChatError $ CEException "cancelSndFileTransfer: cancelling file via a separate connection is deprecated"
@@ -2061,13 +2061,13 @@ batchSndMessagesJSON mode = batchMessages mode maxEncodedMsgLength . L.toList
encodeConnInfo :: MsgEncodingI e => ChatMsgEvent e -> CM ByteString
encodeConnInfo chatMsgEvent = do
- vr <- chatVersionRange
- encodeConnInfoPQ PQSupportOff (maxVersion vr) chatMsgEvent
+ cxt <- chatStoreCxt
+ encodeConnInfoPQ PQSupportOff (maxVersion (vr cxt)) chatMsgEvent
encodeConnInfoPQ :: MsgEncodingI e => PQSupport -> VersionChat -> ChatMsgEvent e -> CM ByteString
encodeConnInfoPQ pqSup v chatMsgEvent = do
- vr <- chatVersionRange
- let info = ChatMessage {chatVRange = vr, msgId = Nothing, chatMsgEvent}
+ cxt <- chatStoreCxt
+ let info = ChatMessage {chatVRange = vr cxt, msgId = Nothing, chatMsgEvent}
case encodeChatMessage maxEncodedInfoLength info of
ECMEncoded connInfo -> case pqSup of
PQSupportOn | v >= pqEncryptionCompressionVersion && B.length connInfo > maxCompressedInfoLength -> do
@@ -2174,11 +2174,11 @@ sendGroupMessage' user gInfo members chatMsgEvent =
-- TODO after restoring from a stale backup (relays accept only strictly-greater versions)
bumpAndBroadcastRoster :: User -> GroupInfo -> CM ()
bumpAndBroadcastRoster user gInfo = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
let rosterVer = maybe (VersionRoster 0) (\(VersionRoster n) -> VersionRoster (n + 1)) (rosterVersion gInfo)
(relays, roster) <- withStore' $ \db -> do
- relays <- getGroupRelayMembers db vr user gInfo
- mods <- getGroupRosterMembers db vr user gInfo
+ relays <- getGroupRelayMembers db cxt user gInfo
+ mods <- getGroupRosterMembers db cxt user gInfo
setGroupRosterVersion db gInfo rosterVer
pure (relays, buildGroupRoster rosterVer mods)
forM_ (L.nonEmpty relays) $ \relays' ->
@@ -2188,8 +2188,8 @@ bumpAndBroadcastRoster user gInfo = do
sendGroupRosterToRelay :: User -> GroupInfo -> GroupMember -> CM ()
sendGroupRosterToRelay user gInfo relayMember =
forM_ (rosterVersion gInfo) $ \rosterVer -> do
- vr <- chatVersionRange
- mods <- withStore' $ \db -> getGroupRosterMembers db vr user gInfo
+ cxt <- chatStoreCxt
+ mods <- withStore' $ \db -> getGroupRosterMembers db cxt user gInfo
void $ sendGroupMessage' user gInfo [relayMember] (XGrpRoster (buildGroupRoster rosterVer mods))
sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult)
@@ -2423,8 +2423,8 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta
withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery $ Just amGroupMemId)
`catchAllErrors` \e -> case e of
ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do
- vr <- chatVersionRange
- fm <- withStore $ \db -> getGroupMember db vr user groupId forwardedByGroupMemberId
+ cxt <- chatStoreCxt
+ fm <- withStore $ \db -> getGroupMember db cxt user groupId forwardedByGroupMemberId
forM_ (memberConn fm) $ \fmConn ->
void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemId) groupId
throwError e
@@ -2444,8 +2444,8 @@ saveGroupFwdRcvMsg user gInfo@GroupInfo {groupId} forwardingMember refAuthorMemb
| useRelays' gInfo -> pure Nothing -- with chat relays, duplicates are expected
| otherwise -> case (authorGroupMemberId, forwardedByGroupMemberId) of
(Just authorGMId, Nothing) -> do
- vr <- chatVersionRange
- am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db vr user groupId authorGMId
+ cxt <- chatStoreCxt
+ am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db cxt user groupId authorGMId
if maybe False (\ref -> sameMemberId (memberId' ref) am) refAuthorMember_
then forM_ (memberConn forwardingMember) $ \fmConn ->
void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemberId) groupId
@@ -2487,9 +2487,9 @@ saveSndChatItems ::
CM [Either ChatError (ChatItem c 'MDSnd)]
saveSndChatItems user cd showGroupAsSender itemsData itemTimed live = do
createdAt <- liftIO getCurrentTime
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
when (contactChatDeleted cd || any (\NewSndChatItemData {content} -> ciRequiresAttention content) (rights itemsData)) $
- void (withStore' $ \db -> updateChatTsStats db vr user cd createdAt Nothing)
+ void (withStore' $ \db -> updateChatTsStats db cxt user cd createdAt Nothing)
lift $ withStoreBatch (\db -> map (bindRight $ createItem db createdAt) itemsData)
where
createItem :: DB.Connection -> UTCTime -> NewSndChatItemData c -> IO (Either ChatError (ChatItem c 'MDSnd))
@@ -2515,14 +2515,14 @@ ciContentNoParse content = (content, (ciContentToText content, Nothing))
saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> Map MemberName MsgMention -> CM (ChatItem c 'MDRcv, ChatInfo c)
saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, msgSigned, forwardedByMember} sharedMsgId_ brokerTs (content, (t, ft_)) ciFile itemTimed live mentions = do
createdAt <- liftIO getCurrentTime
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
withStore' $ \db -> do
(mentions' :: Map MemberName CIMention, userMention) <- case toChatInfo cd of
GroupChat g@GroupInfo {membership} _ -> groupMentions db g membership
_ -> pure (M.empty, False)
cInfo' <-
if (ciRequiresAttention content || contactChatDeleted cd)
- then updateChatTsStats db vr user cd createdAt (memberChatStats userMention)
+ then updateChatTsStats db cxt user cd createdAt (memberChatStats userMention)
else pure $ toChatInfo cd
let showAsGroup = case cd of CDChannelRcv {} -> True; _ -> False
hasLink_ = ciContentHasLink content ft_
@@ -2815,13 +2815,13 @@ createChatItems ::
createChatItems user itemTs_ dirsCIContents = do
createdAt <- liftIO getCurrentTime
let itemTs = fromMaybe createdAt itemTs_
- vr <- chatVersionRange'
- void . withStoreBatch' $ \db -> map (updateChat db vr createdAt) dirsCIContents
+ cxt <- chatStoreCxt'
+ void . withStoreBatch' $ \db -> map (updateChat db cxt createdAt) dirsCIContents
withStoreBatch' $ \db -> concatMap (createACIs db itemTs createdAt) dirsCIContents
where
- updateChat :: DB.Connection -> VersionRangeChat -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) -> IO ()
- updateChat db vr createdAt (cd, _, contents)
- | any (ciRequiresAttention . fst) contents || contactChatDeleted cd = void $ updateChatTsStats db vr user cd createdAt memberChatStats
+ updateChat :: DB.Connection -> StoreCxt -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) -> IO ()
+ updateChat db cxt createdAt (cd, _, contents)
+ | any (ciRequiresAttention . fst) contents || contactChatDeleted cd = void $ updateChatTsStats db cxt user cd createdAt memberChatStats
| otherwise = pure ()
where
memberChatStats :: Maybe (Int, MemberAttention, Int)
@@ -2860,8 +2860,8 @@ createLocalChatItems ::
UTCTime ->
CM [ChatItem 'CTLocal 'MDSnd]
createLocalChatItems user cd itemsData createdAt = do
- vr <- chatVersionRange
- void $ withStore' $ \db -> updateChatTsStats db vr user cd createdAt Nothing
+ cxt <- chatStoreCxt
+ void $ withStore' $ \db -> updateChatTsStats db cxt user cd createdAt Nothing
(errs, items) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (createItem db) $ L.toList itemsData)
unless (null errs) $ toView $ CEvtChatErrors errs
pure items
@@ -2911,6 +2911,14 @@ waitChatStartedAndActivated = do
activated <- readTVar chatActivated
unless (isJust started && activated) retry
+chatStoreCxt :: CM StoreCxt
+chatStoreCxt = lift chatStoreCxt'
+{-# INLINE chatStoreCxt #-}
+
+chatStoreCxt' :: CM' StoreCxt
+chatStoreCxt' = mkStoreCxt <$> asks config
+{-# INLINE chatStoreCxt' #-}
+
chatVersionRange :: CM VersionRangeChat
chatVersionRange = lift chatVersionRange'
{-# INLINE chatVersionRange #-}
diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs
index 5ca033a30f..f6d36415dd 100644
--- a/src/Simplex/Chat/Library/Subscriber.hs
+++ b/src/Simplex/Chat/Library/Subscriber.hs
@@ -124,10 +124,10 @@ processAgentMessage _ "" (ERR e) =
processAgentMessage corrId connId msg = do
lockEntity <- critical connId (withStore (`getChatLockEntity` AgentConnId connId))
withEntityLock "processAgentMessage" lockEntity $ do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
-- getUserByAConnId never throws logical errors, only SEDBBusyError can be thrown here
critical connId (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case
- Just user -> processAgentMessageConn vr user corrId connId msg `catchAllErrors` eToView
+ Just user -> processAgentMessageConn cxt user corrId connId msg `catchAllErrors` eToView
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
-- CRITICAL error will be shown to the user as alert with restart button in Android/desktop apps.
@@ -189,27 +189,27 @@ processAgentMsgSndFile _corrId aFileId msg = do
process :: User -> FileTransferId -> CM ()
process user fileId = do
(ft@FileTransferMeta {xftpRedirectFor, cancelled}, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
unless cancelled $ case msg of
SFPROG sndProgress sndTotal -> do
let status = CIFSSndTransfer {sndProgress, sndTotal}
ci <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId status
- lookupChatItemByFileId db vr user fileId
+ lookupChatItemByFileId db cxt user fileId
toView $ CEvtSndFileProgressXFTP user ci ft sndProgress sndTotal
SFDONE sndDescr rfds -> do
withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr)
- ci <- withStore $ \db -> lookupChatItemByFileId db vr user fileId
+ ci <- withStore $ \db -> lookupChatItemByFileId db cxt user fileId
case ci of
Nothing -> do
lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText rfds)
case rfds of
- [] -> sendFileError (FileErrOther "no receiver descriptions") "no receiver descriptions" vr ft
+ [] -> sendFileError (FileErrOther "no receiver descriptions") "no receiver descriptions" cxt ft
rfd : _ -> case [fd | fd@(FD.ValidFileDescription FD.FileDescription {chunks = [_]}) <- rfds] of
[] -> case xftpRedirectFor of
Nothing -> xftpSndFileRedirect user fileId rfd >>= toView . CEvtSndFileRedirectStartXFTP user ft
- Just _ -> sendFileError (FileErrOther "chaining redirects") "Prohibit chaining redirects" vr ft
+ Just _ -> sendFileError (FileErrOther "chaining redirects") "Prohibit chaining redirects" cxt ft
rfds' -> do
-- we have 1 chunk - use it as URI whether it is redirect or not
ft' <- maybe (pure ft) (\fId -> withStore $ \db -> getFileTransferMeta db user fId) xftpRedirectFor
@@ -242,13 +242,13 @@ processAgentMsgSndFile _corrId aFileId msg = do
sendFileDescriptions (GroupId groupId) rfdsMemberFTs' sharedMsgId
ci' <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
- getChatItemByFileId db vr user fileId
+ getChatItemByFileId db cxt user fileId
lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
toView $ CEvtSndFileCompleteXFTP user ci' ft
where
getRecipients
- | useRelays' g = withStore' $ \db -> getGroupRelayMembers db vr user g
- | otherwise = withStore' $ \db -> getGroupMembers db vr user g
+ | useRelays' g = withStore' $ \db -> getGroupRelayMembers db cxt user g
+ | otherwise = withStore' $ \db -> getGroupMembers db cxt user g
memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
where
@@ -261,10 +261,10 @@ processAgentMsgSndFile _corrId aFileId msg = do
logWarn $ "Sent file warning: " <> err
ci <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId (CIFSSndWarning $ agentFileError e)
- lookupChatItemByFileId db vr user fileId
+ lookupChatItemByFileId db cxt user fileId
toView $ CEvtSndFileWarning user ci ft err
SFERR e ->
- sendFileError (agentFileError e) (tshow e) vr ft
+ sendFileError (agentFileError e) (tshow e) cxt ft
where
fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text
fileDescrText = safeDecodeUtf8 . strEncode
@@ -289,12 +289,12 @@ processAgentMsgSndFile _corrId aFileId msg = do
toMsgReq :: (Connection, (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json)) -> SndMessage -> ChatMsgReq
toMsgReq (conn, _) SndMessage {msgId, msgBody} =
(conn, MsgFlags {notification = hasNotification XMsgFileDescr_}, (vrValue msgBody, [msgId]))
- sendFileError :: FileError -> Text -> VersionRangeChat -> FileTransferMeta -> CM ()
- sendFileError ferr err vr ft = do
+ sendFileError :: FileError -> Text -> StoreCxt -> FileTransferMeta -> CM ()
+ sendFileError ferr err cxt ft = do
logError $ "Sent file error: " <> err
ci <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId (CIFSSndError ferr)
- lookupChatItemByFileId db vr user fileId
+ lookupChatItemByFileId db cxt user fileId
lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
toView $ CEvtSndFileError user ci ft err
@@ -329,13 +329,13 @@ processAgentMsgRcvFile _corrId aFileId msg = do
process :: User -> FileTransferId -> CM ()
process user fileId = do
ft <- withStore $ \db -> getRcvFileTransfer db user fileId
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
unless (rcvFileCompleteOrCancelled ft) $ case msg of
RFPROG rcvProgress rcvTotal -> do
let status = CIFSRcvTransfer {rcvProgress, rcvTotal}
ci <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId status
- lookupChatItemByFileId db vr user fileId
+ lookupChatItemByFileId db cxt user fileId
toView $ CEvtRcvFileProgressXFTP user ci rcvProgress rcvTotal ft
RFDONE xftpPath ->
case liveRcvFileTransferPath ft of
@@ -347,13 +347,13 @@ processAgentMsgRcvFile _corrId aFileId msg = do
liftIO $ do
updateRcvFileStatus db fileId FSComplete
updateCIFileStatus db user fileId CIFSRcvComplete
- lookupChatItemByFileId db vr user fileId
+ lookupChatItemByFileId db cxt user fileId
agentXFTPDeleteRcvFile aFileId fileId
toView $ maybe (CEvtRcvStandaloneFileComplete user fsTargetPath ft) (CEvtRcvFileComplete user) ci_
RFWARN e -> do
ci <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId (CIFSRcvWarning $ agentFileError e)
- lookupChatItemByFileId db vr user fileId
+ lookupChatItemByFileId db cxt user fileId
toView $ CEvtRcvFileWarning user ci e ft
RFERR e
| e == FILE NOT_APPROVED -> do
@@ -364,20 +364,20 @@ processAgentMsgRcvFile _corrId aFileId msg = do
| otherwise -> do
aci_ <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId (CIFSRcvError $ agentFileError e)
- lookupChatItemByFileId db vr user fileId
+ lookupChatItemByFileId db cxt user fileId
forM_ aci_ cleanupACIFile
agentXFTPDeleteRcvFile aFileId fileId
toView $ CEvtRcvFileError user aci_ e ft
type ShouldDeleteGroupConns = Bool
-processAgentMessageConn :: VersionRangeChat -> User -> ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
-processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = do
+processAgentMessageConn :: StoreCxt -> User -> ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
+processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = do
-- Missing connection/entity errors here will be sent to the view but not shown as CRITICAL alert,
-- as in this case no need to ACK message - we can't process messages for this connection anyway.
-- SEDBException will be re-trown as CRITICAL as it is likely to indicate a temporary database condition
-- that will be resolved with app restart.
- entity <- critical agentConnId $ withStore (\db -> getConnectionEntity db vr user $ AgentConnId agentConnId) >>= updateConnStatus
+ entity <- critical agentConnId $ withStore (\db -> getConnectionEntity db cxt user $ AgentConnId agentConnId) >>= updateConnStatus
case agentMessage of
END -> case entity of
RcvDirectMsgConnection _ (Just ct) -> toView $ CEvtContactAnotherClient user ct
@@ -580,7 +580,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- XGrpLinkInv here means we are connecting via business contact card, so we replace contact with group
(gInfo, host) <- withStore $ \db -> do
liftIO $ deleteContactCardKeepConn db connId ct
- createGroupInvitedViaLink db vr user conn'' glInv
+ createGroupInvitedViaLink db cxt user conn'' glInv
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart)
-- [incognito] send saved profile
incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId)
@@ -632,7 +632,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
when (connChatVersion < batchSend2Version) $ forM_ (autoReply $ addressSettings ucl) $ \mc -> sendAutoReply ct' mc Nothing -- old versions only
-- TODO REMOVE LEGACY vvv
forM_ gli_ $ \GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
- groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId
+ groupInfo <- withStore $ \db -> getGroupInfo db cxt user groupId
subMode <- chatReadVar subscriptionMode
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
gVar <- asks random
@@ -743,7 +743,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- [async agent commands] group link auto-accept continuation on receiving INV
CFCreateConnGrpInv -> do
(ct, groupLinkId) <- withStore $ \db -> do
- ct <- getContactViaMember db vr user m
+ ct <- getContactViaMember db cxt user m
liftIO $ setNewContactMemberConnRequest db user m cReq
liftIO $ (ct,) <$> getGroupLinkId db user gInfo
sendGrpInvitation ct m groupLinkId
@@ -811,7 +811,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
pgId = fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId),
useRelays' gInfo == isJust rcvPG && pgId rcvPG == pgId curPG -> do
-- XGrpLinkInv here means we are connecting via prepared group, and we have to update user and host member records
- (gInfo', m') <- withStore $ \db -> updatePreparedUserAndHostMembersInvited db vr user gInfo m glInv
+ (gInfo', m') <- withStore $ \db -> updatePreparedUserAndHostMembersInvited db cxt user gInfo m glInv
-- [incognito] send saved profile
incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId)
let profileToSend = userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
@@ -819,7 +819,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
toView $ CEvtGroupLinkConnecting user gInfo' m'
| otherwise -> messageError "x.grp.link.inv: publicGroupId mismatch"
XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do
- (gInfo', m') <- withStore $ \db -> updatePreparedUserAndHostMembersRejected db vr user gInfo m glRjct
+ (gInfo', m') <- withStore $ \db -> updatePreparedUserAndHostMembersRejected db cxt user gInfo m glRjct
toView $ CEvtGroupLinkConnecting user gInfo' m'
toViewTE $ TEGroupLinkRejected user gInfo' rejectionReason
_ -> messageError "CONF from host member in prepared group must have x.grp.link.inv or x.grp.link.reject"
@@ -893,7 +893,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
where
firstConnectedHost
| useRelays' gInfo = do
- relayMems <- withStore' $ \db -> getGroupRelayMembers db vr user gInfo
+ relayMems <- withStore' $ \db -> getGroupRelayMembers db cxt user gInfo
let numConnected = length $ filter (\GroupMember {memberStatus = ms} -> ms == GSMemConnected) relayMems
pure $ numConnected == 1
| otherwise = pure True
@@ -929,13 +929,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
when (connChatVersion < batchSend2Version) $ getAutoReplyMsg >>= mapM_ (\mc -> sendGroupAutoReply mc Nothing)
if useRelays' gInfo''
then do
- introduceInChannel vr user gInfo'' m'
+ introduceInChannel cxt user gInfo'' m'
when (groupFeatureAllowed SGFHistory gInfo'') $ sendHistory user gInfo'' m'
else case mStatus of
GSMemPendingApproval -> pure ()
- GSMemPendingReview -> introduceToModerators vr user gInfo'' m'
+ GSMemPendingReview -> introduceToModerators cxt user gInfo'' m'
_ -> do
- introduceToAll vr user gInfo'' m'
+ introduceToAll cxt user gInfo'' m'
let memberIsCustomer = case businessChat gInfo'' of
Just BusinessChatInfo {chatType = BCCustomer, customerId} -> memberId' m' == customerId
_ -> False
@@ -958,12 +958,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
sendXGrpMemCon = \case
GCPreMember ->
forM_ (invitedByGroupMemberId membership) $ \hostId -> do
- host <- withStore $ \db -> getGroupMember db vr user groupId hostId
+ host <- withStore $ \db -> getGroupMember db cxt user groupId hostId
forM_ (memberConn host) $ \hostConn ->
void $ sendDirectMemberMessage hostConn (XGrpMemCon memberId) groupId
GCPostMember ->
forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do
- im <- withStore $ \db -> getGroupMember db vr user groupId invitingMemberId
+ im <- withStore $ \db -> getGroupMember db cxt user groupId invitingMemberId
forM_ (memberConn im) $ \imConn ->
void $ sendDirectMemberMessage imConn (XGrpMemCon memberId) groupId
_ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected"
@@ -1224,7 +1224,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
confId <- withStore $ \db -> do
confId <- getRelayConfId db m
liftIO $ updateGroupMemberStatus db userId m GSMemAccepted
- void $ setRelayKey db vr user m (MemberKey relayKey) relayProfile
+ void $ setRelayKey db cxt user m (MemberKey relayKey) relayProfile
pure confId
allowAgentConnectionAsync user conn confId XOk
else
@@ -1313,7 +1313,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
FileChunkCancel ->
unless (rcvFileCompleteOrCancelled ft) $ do
cancelRcvFileTransfer user ft
- ci <- withStore $ \db -> getChatItemByFileId db vr user fileId
+ ci <- withStore $ \db -> getChatItemByFileId db cxt user fileId
toView $ CEvtRcvFileSndCancelled user ci ft
FileChunk {chunkNo, chunkBytes = chunk} -> do
case integrity of
@@ -1336,7 +1336,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
updateRcvFileStatus db fileId FSComplete
updateCIFileStatus db user fileId CIFSRcvComplete
deleteRcvFileChunks db ft
- getChatItemByFileId db vr user fileId
+ getChatItemByFileId db cxt user fileId
toView $ CEvtRcvFileComplete user ci
mapM_ (deleteAgentConnectionAsync . aConnId) conn_
RcvChunkDuplicate -> withAckMessage' "file msg" agentConnId meta $ pure ()
@@ -1361,7 +1361,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
case (ucGroupId_, auData) of
(Just groupId, UserContactLinkData UserContactData {relays = relayLinks}) -> do
(gInfo, gLink, relays, relaysChanged, newlyActiveLinks, newlyActiveGMIds) <- withStore $ \db -> do
- gInfo <- getGroupInfo db vr user groupId
+ gInfo <- getGroupInfo db cxt user groupId
gLink <- getGroupLink db user gInfo
relays <- liftIO $ getGroupRelays db gInfo
(relays', changed, newlyActiveLinks, newlyActiveGMIds) <- liftIO $ foldrM (updateRelay db) ([], False, [], []) relays
@@ -1374,7 +1374,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- dedicated subscriber count).
when (fromMaybe 0 publicMemberCount > 1) $
forM_ (L.nonEmpty newlyActiveLinks) $ \newlyActive -> do
- allRelayMembers <- withFastStore' $ \db -> getGroupRelayMembers db vr user gInfo
+ allRelayMembers <- withFastStore' $ \db -> getGroupRelayMembers db cxt user gInfo
let recipients =
filter
(\GroupMember {memberStatus, relayLink} ->
@@ -1385,7 +1385,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
void $ sendGroupMessages user gInfo Nothing False recipients events
-- send the current roster to relays that just became active so they can serve joiners
forM_ newlyActiveGMIds $ \gmId ->
- (withStore (\db -> getGroupMemberById db vr user gmId) >>= sendGroupRosterToRelay user gInfo) `catchAllErrors` eToView
+ (withStore (\db -> getGroupMemberById db cxt user gmId) >>= sendGroupRosterToRelay user gInfo) `catchAllErrors` eToView
where
updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId]) -> IO ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId])
updateRelay db relay@GroupRelay {groupMemberId, relayLink, relayStatus} (acc, changed, newlyActiveLinks, newlyActiveGMIds) =
@@ -1427,7 +1427,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
AddressSettings {autoAccept} = addressSettings
isSimplexTeam = sameConnReqContact connReq adminContactReq
gVar <- asks random
- withStore (\db -> createOrUpdateContactRequest db gVar vr user uclId ucl isSimplexTeam invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup) >>= \case
+ withStore (\db -> createOrUpdateContactRequest db gVar cxt user uclId ucl isSimplexTeam invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup) >>= \case
RSAcceptedRequest _ucr re -> case re of
REContact ct ->
-- TODO [short links] update request msg
@@ -1559,7 +1559,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- ##### Group link join requests (don't create contact requests) #####
Just gli@GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
-- TODO [short links] deduplicate request by xContactId?
- gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
+ gInfo <- withStore $ \db -> getGroupInfo db cxt user groupId
if useRelays' gInfo
then messageWarning $ "processContactConnMessage (group " <> groupName' gInfo <> "): ignored direct join request from " <> displayName <> " (group uses relays)"
else do
@@ -1585,10 +1585,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
rejected <- withStore' $ \db -> isRelayGroupRejected db user groupLink
initialDelay <- asks $ initialInterval . relayRequestRetryInterval . config
if rejected
- then rejectRelayInvitationAsync user uclId vr groupRelayInv invId chatVRange initialDelay RRRRejoinRejected
+ then rejectRelayInvitationAsync user uclId cxt groupRelayInv invId chatVRange initialDelay RRRRejoinRejected
else do
(_gInfo, _ownerMember) <- withStore $ \db ->
- createRelayRequestGroup db vr user groupRelayInv invId chatVRange initialDelay GSMemAccepted RSInvited
+ createRelayRequestGroup db cxt user groupRelayInv invId chatVRange initialDelay GSMemAccepted RSInvited
lift $ void $ getRelayRequestWorker True
xGrpRelayTest :: InvitationId -> VersionRangeChat -> ByteString -> CM ()
xGrpRelayTest invId chatVRange challenge = do
@@ -1603,7 +1603,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
let chatV = chatVR `peerConnChatVersion` chatVRange
(cmdId, acId) <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV
withStore $ \db -> do
- Connection {connId = testCId} <- createRelayTestConnection db vr user acId ConnAccepted chatV subMode
+ Connection {connId = testCId} <- createRelayTestConnection db cxt user acId ConnAccepted chatV subMode
liftIO $ setCommandConnId db user cmdId testCId
-- TODO [relays] owner, relays: TBC how to communicate member rejection rules from owner to relays
memberJoinRequestViaRelay :: InvitationId -> VersionRangeChat -> Maybe SignedMsg -> Profile -> MemberId -> MemberKey -> Maybe MemberId -> CM ()
@@ -1611,8 +1611,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
(_ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId
case gLinkInfo_ of
Just GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
- gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
- existing_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupMemberByMemberId db vr user gInfo joiningMemberId)
+ gInfo <- withStore $ \db -> getGroupInfo db cxt user groupId
+ existing_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupMemberByMemberId db cxt user gInfo joiningMemberId)
case existing_ of
Just rosterMem
-- a privileged memberId's key is owner-authoritative (the roster); the joiner must prove
@@ -1800,7 +1800,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- sendProbe -> sendProbeHashes (currently)
-- sendProbeHashes -> sendProbe (reversed - change order in code, may add delay)
sendProbe probe
- ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db vr user ct)
+ ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db cxt user ct)
sendProbeHashes ms probe probeId
else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32)
where
@@ -1816,7 +1816,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
then do
(probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId $ COMGroupMember m
sendProbe probe
- cs <- map COMContact <$> withStore' (\db -> getMatchingMemberContacts db vr user m)
+ cs <- map COMContact <$> withStore' (\db -> getMatchingMemberContacts db cxt user m)
sendProbeHashes cs probe probeId
else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32)
where
@@ -1889,7 +1889,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
messageFileDescription Contact {contactId} sharedMsgId fileDescr = do
(fileId, aci) <- withStore $ \db -> do
fileId <- getFileIdBySharedMsgId db userId contactId sharedMsgId
- aci <- getChatItemByFileId db vr user fileId
+ aci <- getChatItemByFileId db cxt user fileId
pure (fileId, aci)
processFDMessage fileId aci fileDescr
@@ -1897,7 +1897,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
groupMessageFileDescription g@GroupInfo {groupId} m_ sharedMsgId fileDescr = do
(fileId, aci) <- withStore $ \db -> do
fileId <- getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
- aci <- getChatItemByFileId db vr user fileId
+ aci <- getChatItemByFileId db cxt user fileId
pure (fileId, aci)
case aci of
AChatItem SCTGroup SMDRcv (GroupChat _g scopeInfo) ChatItem {chatDir}
@@ -2058,7 +2058,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
cci <- case itemMemberId of
Just itemMemberId' -> getGroupMemberCIBySharedMsgId db user g itemMemberId' sharedMsgId
Nothing -> getGroupChatItemBySharedMsgId db user g Nothing sharedMsgId
- scopeInfo <- getGroupChatScopeInfoForItem db vr user g (cChatItemId cci)
+ scopeInfo <- getGroupChatScopeInfoForItem db cxt user g (cChatItemId cci)
pure (cci, scopeInfo)
if ciReactionAllowed ci
then do
@@ -2096,13 +2096,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- no delivery task - message already forwarded by relay
pure Nothing
Just m@GroupMember {memberId} -> do
- (gInfo', m', scopeInfo) <- mkGetMessageChatScope vr user gInfo m content msgScope_
+ (gInfo', m', scopeInfo) <- mkGetMessageChatScope cxt user gInfo m content msgScope_
if blockedByAdmin m'
then createBlockedByAdmin gInfo' (Just m') scopeInfo $> Nothing
else case prohibitedGroupContent gInfo' m' scopeInfo content ft_ fInv_ False of
Just f -> rejected gInfo' (Just m') scopeInfo f $> Nothing
Nothing ->
- withStore' (\db -> getCIModeration db vr user gInfo' memberId sharedMsgId_) >>= \case
+ withStore' (\db -> getCIModeration db cxt user gInfo' memberId sharedMsgId_) >>= \case
Just ciModeration -> do
applyModeration gInfo' m' scopeInfo ciModeration
withStore' $ \db -> deleteCIModeration db gInfo' memberId sharedMsgId_
@@ -2192,7 +2192,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
else case m_ of
Just m -> do
let mentions' = if memberBlocked m then [] else mentions
- (gInfo', m', scopeInfo) <- mkGetMessageChatScope vr user gInfo m mc msgScope_
+ (gInfo', m', scopeInfo) <- mkGetMessageChatScope cxt user gInfo m mc msgScope_
pure (gInfo', CDGroupRcv gInfo' scopeInfo m', mentions', scopeInfo)
Nothing -> pure (gInfo, CDChannelRcv gInfo Nothing, mentions, Nothing)
case m_ >>= \m -> prohibitedGroupContent gInfo' m scopeInfo mc ft_ (Nothing :: Maybe String) False of
@@ -2223,7 +2223,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
else case m_ of
Just m -> getGroupMemberCIBySharedMsgId db user gInfo (memberId' m) sharedMsgId
Nothing -> getGroupChatItemBySharedMsgId db user gInfo Nothing sharedMsgId
- (cci,) <$> getGroupChatScopeInfoForItem db vr user gInfo (cChatItemId cci)
+ (cci,) <$> getGroupChatScopeInfoForItem db cxt user gInfo (cChatItemId cci)
case cci of
CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC}
| isSender m' -> updateCI False ci scopeInfo oldMC itemLive (Just $ memberId' m')
@@ -2335,7 +2335,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
| otherwise = a
delete :: CChatItem 'CTGroup -> Bool -> Maybe GroupMember -> CM (Maybe DeliveryTaskContext)
delete cci asGroup byGroupMember = do
- scopeInfo <- withStore $ \db -> getGroupChatScopeInfoForItem db vr user gInfo (cChatItemId cci)
+ scopeInfo <- withStore $ \db -> getGroupChatScopeInfoForItem db cxt user gInfo (cChatItemId cci)
let fullDelete
| asGroup = groupFeatureAllowed SGFFullDelete gInfo
| otherwise = maybe False (\m -> groupFeatureMemberAllowed SGFFullDelete m gInfo) m_
@@ -2403,14 +2403,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
(fileId,) <$> getRcvFileTransfer db user fileId
unless (rcvFileCompleteOrCancelled ft) $ do
cancelRcvFileTransfer user ft
- ci <- withStore $ \db -> getChatItemByFileId db vr user fileId
+ ci <- withStore $ \db -> getChatItemByFileId db cxt user fileId
toView $ CEvtRcvFileSndCancelled user ci ft
xFileAcptInv :: Contact -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM ()
xFileAcptInv ct sharedMsgId fileConnReq_ fName = do
(fileId, AChatItem _ _ _ ci) <- withStore $ \db -> do
fileId <- getDirectFileIdBySharedMsgId db user ct sharedMsgId
- (fileId,) <$> getChatItemByFileId db vr user fileId
+ (fileId,) <$> getChatItemByFileId db cxt user fileId
assertSMPAcceptNotProhibited ci
ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId)
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
@@ -2419,7 +2419,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- receiving inline
Nothing -> do
event <- withStore $ \db -> do
- ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1
+ ci' <- updateDirectCIFileStatus db cxt user fileId $ CIFSSndTransfer 0 1
sft <- createSndDirectInlineFT db ct ft
pure $ CEvtSndFileStart user ci' sft
toView event
@@ -2447,7 +2447,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
forM_ sft_ $ \sft@SndFileTransfer {fileId} -> do
ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> do
liftIO $ updateSndFileStatus db sft FSComplete
- updateDirectCIFileStatus db vr user fileId CIFSSndComplete
+ updateDirectCIFileStatus db cxt user fileId CIFSSndComplete
case file of
Just CIFile {fileProtocol = FPXFTP} -> do
ft <- withStore $ \db -> getFileTransferMeta db user fileId
@@ -2485,7 +2485,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xFileCancelGroup g@GroupInfo {groupId} m_ sharedMsgId = do
(fileId, aci) <- withStore $ \db -> do
fileId <- getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
- (fileId,) <$> getChatItemByFileId db vr user fileId
+ (fileId,) <$> getChatItemByFileId db cxt user fileId
case aci of
AChatItem SCTGroup SMDRcv (GroupChat _g scopeInfo) ChatItem {chatDir}
| validSender m_ chatDir -> do
@@ -2501,7 +2501,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xFileAcptInvGroup GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName = do
(fileId, AChatItem _ _ _ ci) <- withStore $ \db -> do
fileId <- getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
- (fileId,) <$> getChatItemByFileId db vr user fileId
+ (fileId,) <$> getChatItemByFileId db cxt user fileId
assertSMPAcceptNotProhibited ci
-- TODO check that it's not already accepted
ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId)
@@ -2510,7 +2510,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
(Nothing, Just conn) -> do
-- receiving inline
event <- withStore $ \db -> do
- ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1
+ ci' <- updateDirectCIFileStatus db cxt user fileId $ CIFSSndTransfer 0 1
sft <- liftIO $ createSndGroupInlineFT db m conn ft
pure $ CEvtSndFileStart user ci' sft
toView event
@@ -2536,7 +2536,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c)
when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId
-- [incognito] if direct connection with host is incognito, create membership using the same incognito profile
- (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership}, hostId) <- withStore $ \db -> createGroupInvitation db vr user ct inv customUserProfileId
+ (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership}, hostId) <- withStore $ \db -> createGroupInvitation db cxt user ct inv customUserProfileId
void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart)
let GroupMember {groupMemberId, memberId = membershipMemId} = membership
if sameGroupLinkId groupLinkId groupLinkId'
@@ -2577,7 +2577,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
then do
(ct', contactConns) <- withStore' $ \db -> do
ct' <- updateContactStatus db user c CSDeleted
- (ct',) <$> getContactConnections db vr userId ct'
+ (ct',) <$> getContactConnections db cxt userId ct'
deleteAgentConnectionsAsync $ map aConnId contactConns
forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted
activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted}
@@ -2586,7 +2586,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv cInfo ci]
toView $ CEvtContactDeletedByContact user ct''
else do
- contactConns <- withStore' $ \db -> getContactConnections db vr userId c
+ contactConns <- withStore' $ \db -> getContactConnections db cxt userId c
deleteAgentConnectionsAsync $ map aConnId contactConns
withStore $ \db -> deleteContact db user c
where
@@ -2655,7 +2655,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
messageError "x.grp.link.acpt with insufficient member permissions"
| sameMemberId memberId membership = processUserAccepted
| otherwise =
- withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case
+ withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memberId) >>= \case
Left _ -> messageError "x.grp.link.acpt error: referenced member does not exist"
Right referencedMember -> do
(referencedMember', gInfo') <- withStore' $ \db -> do
@@ -2699,7 +2699,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
GAPendingApproval ->
messageWarning "x.grp.link.acpt: unexpected group acceptance - pending approval"
introduceToRemainingMembers acceptedMember = do
- introduceToRemaining vr user gInfo acceptedMember
+ introduceToRemaining cxt user gInfo acceptedMember
when (groupFeatureAllowed SGFHistory gInfo) $ sendHistory user gInfo acceptedMember
maybeCreateGroupDescrLocal :: GroupInfo -> GroupMember -> CM ()
@@ -2721,7 +2721,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
toView $ CEvtGroupMemberUpdated user gInfo m m'
pure m'
Just mContactId -> do
- mCt <- withStore $ \db -> getContact db vr user mContactId
+ mCt <- withStore $ \db -> getContact db cxt user mContactId
if canUpdateProfile mCt
then do
(m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p'
@@ -2769,7 +2769,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
contactMerge <- readTVarIO =<< asks contactMergeEnabled
-- [incognito] unless connected incognito
when (contactMerge && not (contactOrMemberIncognito cgm2)) $ do
- cgm1s <- withStore' $ \db -> matchReceivedProbe db vr user cgm2 probe
+ cgm1s <- withStore' $ \db -> matchReceivedProbe db cxt user cgm2 probe
let cgm1s' = filter (not . contactOrMemberIncognito) cgm1s
probeMatches cgm1s' cgm2
where
@@ -2785,7 +2785,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
contactMerge <- readTVarIO =<< asks contactMergeEnabled
-- [incognito] unless connected incognito
when (contactMerge && not (contactOrMemberIncognito cgm1)) $ do
- cgm2Probe_ <- withStore' $ \db -> matchReceivedProbeHash db vr user cgm1 probeHash
+ cgm2Probe_ <- withStore' $ \db -> matchReceivedProbeHash db cxt user cgm1 probeHash
forM_ cgm2Probe_ $ \(cgm2, probe) ->
unless (contactOrMemberIncognito cgm2) . void $
probeMatch cgm1 cgm2 probe
@@ -2815,7 +2815,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xInfoProbeOk :: ContactOrMember -> Probe -> CM ()
xInfoProbeOk cgm1 probe = do
- cgm2 <- withStore' $ \db -> matchSentProbe db vr user cgm1 probe
+ cgm2 <- withStore' $ \db -> matchSentProbe db cxt user cgm1 probe
case cgm1 of
COMContact c1 ->
case cgm2 of
@@ -2964,14 +2964,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
associateMemberWithContact c1 m2@GroupMember {groupId} = do
g <- withStore $ \db -> do
liftIO $ associateMemberWithContactRecord db user c1 m2
- getGroupInfo db vr user groupId
+ getGroupInfo db cxt user groupId
toView $ CEvtContactAndMemberAssociated user c1 g m2 c1
pure c1
associateContactWithMember :: GroupMember -> Contact -> CM Contact
associateContactWithMember m1@GroupMember {groupId} c2 = do
(c2', g) <- withStore $ \db ->
- liftM2 (,) (associateContactWithMemberRecord db vr user m1 c2) (getGroupInfo db vr user groupId)
+ liftM2 (,) (associateContactWithMemberRecord db cxt user m1 c2) (getGroupInfo db cxt user groupId)
toView $ CEvtContactAndMemberAssociated user c2 g m1 c2'
pure c2'
@@ -2981,15 +2981,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
conn' <- updatePeerChatVRange activeConn chatVRange
case chatMsgEvent of
XInfo p -> do
- ct <- withStore $ \db -> createDirectContact db vr user conn' p
+ ct <- withStore $ \db -> createDirectContact db cxt user conn' p
toView $ CEvtContactConnecting user ct
pure (conn', Nothing)
XGrpLinkInv glInv -> do
- (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db vr user conn' glInv
+ (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db cxt user conn' glInv
toView $ CEvtGroupLinkConnecting user gInfo host
pure (conn', Just gInfo)
XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do
- (gInfo, host) <- withStore $ \db -> createGroupRejectedViaLink db vr user conn' glRjct
+ (gInfo, host) <- withStore $ \db -> createGroupRejectedViaLink db cxt user conn' glRjct
toView $ CEvtGroupLinkConnecting user gInfo host
toViewTE $ TEGroupLinkRejected user gInfo rejectionReason
pure (conn', Just gInfo)
@@ -3003,7 +3003,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
if sameMemberId memId (membership gInfo)
then pure Nothing
else
- withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
+ withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
Right unknownMember@GroupMember {memberStatus = GSMemUnknown}
-- roster-established privileged member: the relay may update the profile only,
-- never the role or key (those are owner-authoritative via the roster, and
@@ -3016,7 +3016,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- TODO [relays] member: surface relay-key-mismatch as a dedicated event / chat item / relay state
when (assertedKey /= memberPubKey unknownMember) $
messageWarning $ "x.grp.mem.new: relay asserted key differs from roster-established key, keeping roster key, memberId=" <> safeDecodeUtf8 (strEncode memId)
- updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db vr user m unknownMember memInfo initialStatus
+ updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db cxt user m unknownMember memInfo initialStatus
-- roster members can't be pending, so no members-require-attention update
gInfo' <- updatePublicGroupData user gInfo
toView $ CEvtUnknownMemberAnnounced user gInfo' m unknownMember updatedMember
@@ -3027,7 +3027,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
messageError "x.grp.mem.new: privileged role not established by roster" $> Nothing
| otherwise -> do
(updatedMember, gInfo') <- withStore $ \db -> do
- updatedMember <- updateUnknownMemberAnnounced db vr user m unknownMember memInfo initialStatus
+ updatedMember <- updateUnknownMemberAnnounced db cxt user m unknownMember memInfo initialStatus
gInfo' <-
if memberPending updatedMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
@@ -3083,10 +3083,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _ _) memRestrictions = do
case memberCategory m of
GCHostMember ->
- withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
+ withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
Right existingMember
| useRelays' gInfo -> do
- updatedMember <- withStore $ \db -> updatePreparedChannelMember db vr user existingMember memInfo
+ updatedMember <- withStore $ \db -> updatePreparedChannelMember db cxt user existingMember memInfo
toView $ CEvtGroupMemberUpdated user gInfo existingMember updatedMember
| otherwise ->
messageError "x.grp.mem.intro ignored: member already exists"
@@ -3107,7 +3107,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
subMode <- chatReadVar subscriptionMode
-- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second
groupConnIds <- createConn subMode
- let chatV = maybe (minVersion vr) (\peerVR -> vr `peerConnChatVersion` fromChatVRange peerVR) memChatVRange
+ let chatV = maybe (minVersion (vr cxt)) (\peerVR -> vr cxt `peerConnChatVersion` fromChatVRange peerVR) memChatVRange
void $ withStore $ \db -> do
reMember <- createIntroReMember db user gInfo memInfo memRestrictions
createIntroReMemberConn db user m reMember chatV memInfo groupConnIds subMode
@@ -3118,7 +3118,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> CM ()
sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do
- hostConn <- withStore $ \db -> getConnectionById db vr user hostConnId
+ hostConn <- withStore $ \db -> getConnectionById db cxt user hostConnId
let msg = XGrpMemInv memberId IntroInvitation {groupConnReq, directConnReq}
void $ sendDirectMemberMessage hostConn msg groupId
withStore' $ \db -> updateGroupMemberStatusById db userId groupMemberId GSMemIntroInvited
@@ -3127,7 +3127,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xGrpMemInv gInfo m memId introInv = do
case memberCategory m of
GCInviteeMember ->
- withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
+ withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
Left _ -> messageError "x.grp.mem.inv error: referenced member does not exist"
Right reMember -> sendGroupMemberMessage gInfo reMember $ XGrpMemFwd (memberInfo gInfo m) introInv
_ -> messageError "x.grp.mem.inv can be only sent by invitee member"
@@ -3138,7 +3138,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
checkHostRole m memRole
toMember <- withStore $ \db -> do
toMember <-
- getGroupMemberByMemberId db vr user gInfo memId
+ getGroupMemberByMemberId db cxt user gInfo memId
-- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent
-- the situation when member does not exist is an error
-- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
@@ -3162,7 +3162,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user Nothing True dcr dm subMode
let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
- chatV = vr `peerConnChatVersion` mcvr
+ chatV = vr cxt `peerConnChatVersion` mcvr
withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds directConnIds customUserProfileId subMode
xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
@@ -3171,7 +3171,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
let gInfo' = gInfo {membership = membership {memberRole = memRole}}
in changeMemberRole gInfo' membership $ RGEUserRole memRole
| otherwise =
- withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
+ withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole
-- in relay groups the roster delivers the chat item for previously-unknown privileged members
Left _
@@ -3242,7 +3242,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
let rosterIds = map (\RosterMember {memberId} -> memberId) entries
acc <- foldrM applyRosterEntry ([], []) entries
-- absent privileged members revert to the joiner default
- currentPriv <- liftIO $ getGroupRosterMembers db vr user gInfo
+ currentPriv <- liftIO $ getGroupRosterMembers db cxt user gInfo
liftIO $ forM_ currentPriv $ \m ->
when (memberId' m `notElem` rosterIds) $
updateGroupMemberRole db user m defaultRole
@@ -3253,7 +3253,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
apply `catchAllErrors` \_ -> pure (cs, as)
where
applied m = (cs, ((m :: GroupMember) {memberRole = role}, memberRole' m) : as)
- apply = getCreateUnknownGMByMemberId db vr user gInfo memberId name defaultRole True >>= \case
+ apply = getCreateUnknownGMByMemberId db cxt user gInfo memberId name defaultRole True >>= \case
Nothing -> pure (cs, as)
Just (m, _) -> case memberPubKey m of
Just k
@@ -3311,7 +3311,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
| membershipMemId == memId = pure Nothing -- ignore - XGrpMemRestrict can be sent to restricted member for efficiency
| otherwise = do
unknownRole <- unknownMemberRole gInfo
- withStore (\db -> getCreateUnknownGMByMemberId db vr user gInfo memId "" unknownRole True) >>= \case
+ withStore (\db -> getCreateUnknownGMByMemberId db cxt user gInfo memId "" unknownRole True) >>= \case
Nothing -> messageError "x.grp.mem.restrict: no member" $> Nothing -- shouldn't happen
Just (bm, unknown) -> do
let GroupMember {groupMemberId = bmId, memberRole, blockedByAdmin, memberProfile = bmp} = bm
@@ -3335,7 +3335,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> CM ()
xGrpMemCon gInfo sendingMem memId = do
- refMem <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo memId
+ refMem <- withStore $ \db -> getGroupMemberByMemberId db cxt user gInfo memId
-- Updating vectors in separate transactions to avoid deadlocks.
withStore $ \db -> setMemberVectorRelationConnected db sendingMem refMem MRSubjectConnected
withStore $ \db -> setMemberVectorRelationConnected db refMem sendingMem MRReferencedConnected
@@ -3357,7 +3357,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
toView $ CEvtDeletedMemberUser user gInfo {membership = membership'} m withMessages msgSigned
pure $ Just DJSGroup {jobSpec = DJRelayRemoved}
else
- withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
+ withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
Left _ -> do
messageError "x.grp.mem.del with unknown member ID"
pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = True}}
@@ -3507,7 +3507,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
case memberContactId of
Nothing -> createNewContact subMode
Just mContactId -> do
- mCt <- withStore $ \db -> getContact db vr user mContactId
+ mCt <- withStore $ \db -> getContact db cxt user mContactId
let Contact {activeConn, contactGrpInvSent} = mCt
forM_ activeConn $ \Connection {connId} ->
if contactGrpInvSent
@@ -3534,7 +3534,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
mCt' <- withStore $ \db -> do
updateMemberContactInvited db user mCt groupDirectInv
void $ liftIO $ createMemberContactConn db user acId (Just cmdId) g mConn ConnJoined mContactId subMode
- getContact db vr user mContactId
+ getContact db cxt user mContactId
securityCodeChanged mCt'
createItems mCt' m
| otherwise = do
@@ -3542,7 +3542,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
mCt' <- withStore $ \db -> do
updateMemberContactInvited db user mCt groupDirectInv
void $ liftIO $ createMemberContactConn db user acId Nothing g mConn ConnPrepared mContactId subMode
- getContact db vr user mContactId
+ getContact db cxt user mContactId
securityCodeChanged mCt'
createInternalChatItem user (CDDirectRcv mCt') (CIRcvDirectEvent $ RDEGroupInvLinkReceived gp) Nothing
createItems mCt' m
@@ -3553,7 +3553,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
(mCt, m') <- withStore $ \db -> do
(mContactId, m') <- liftIO $ createMemberContactInvited db user g m groupDirectInv
void $ liftIO $ createMemberContactConn db user acId (Just cmdId) g mConn ConnJoined mContactId subMode
- mCt <- getContact db vr user mContactId
+ mCt <- getContact db cxt user mContactId
pure (mCt, m')
createInternalChatItem user (CDDirectSnd mCt) CIChatBanner (Just epochStart)
createItems mCt m'
@@ -3562,7 +3562,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
(mCt, m') <- withStore $ \db -> do
(mContactId, m') <- liftIO $ createMemberContactInvited db user g m groupDirectInv
void $ liftIO $ createMemberContactConn db user acId Nothing g mConn ConnPrepared mContactId subMode
- mCt <- getContact db vr user mContactId
+ mCt <- getContact db cxt user mContactId
pure (mCt, m')
createInternalChatItem user (CDDirectSnd mCt) CIChatBanner (Just epochStart)
createInternalChatItem user (CDDirectRcv mCt) (CIRcvDirectEvent $ RDEGroupInvLinkReceived gp) Nothing
@@ -3593,7 +3593,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
FwdMember memberId memberName -> do
unknownRole <- unknownMemberRole gInfo
let allowCreate = toCMEventTag chatMsgEvent /= XGrpLeave_
- withStore (\db -> getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownRole allowCreate) >>= \case
+ withStore (\db -> getCreateUnknownGMByMemberId db cxt user gInfo memberId memberName unknownRole allowCreate) >>= \case
Just (author, unknown)
| memberRemoved author ->
logInfo $ "x.grp.msg.forward: ignoring content from removed member, group " <> tshow (groupId' gInfo) <> ", member " <> safeDecodeUtf8 (strEncode memberId) <> ", event " <> tshow (toCMEventTag chatMsgEvent)
@@ -3650,8 +3650,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
Just sm@SignedMsg {chatBinding, signatures, signedBody}
| GroupMember {memberPubKey = Just pubKey, memberId} <- member ->
case chatBinding of
- CBGroup | Just GroupKeys {publicGroupId} <- groupKeys gInfo ->
- signed MSSVerified <$ guard (verifyGroupSig pubKey publicGroupId memberId signatures signedBody)
+ CBGroup
+ | Just GroupKeys {publicGroupId} <- groupKeys gInfo ->
+ signed MSSVerified <$ guard (verifyGroupSig pubKey publicGroupId memberId signatures signedBody)
+ | otherwise ->
+ let prefix = smpEncode chatBinding <> smpEncode (memberId, pubKey) -- forward compatibility for verifying signed messages in p2p groups
+ in signed MSSVerified <$ guard (all (\(MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 pubKey) sig (prefix <> signedBody)) signatures)
_ -> signed MSSSignedNoKey <$ guard signatureOptional
| otherwise -> signed MSSSignedNoKey <$ guard (signatureOptional || unverifiedAllowed membership member tag)
where
@@ -3723,7 +3727,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- SENT and RCVD events are received for messages that may be batched in single scope,
-- so we can look up scope of first item
scopeInfo <- case cis of
- (ci : _) -> getGroupChatScopeInfoForItem db vr user gInfo (chatItemId' ci)
+ (ci : _) -> getGroupChatScopeInfoForItem db cxt user gInfo (chatItemId' ci)
_ -> pure Nothing
pure $ map (gItem scopeInfo) cis
unless (null acis) $ toView $ CEvtChatItemsStatusesUpdated user acis
@@ -3747,14 +3751,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
deleteGroupConnections :: User -> GroupInfo -> Bool -> CM ()
deleteGroupConnections user gInfo@GroupInfo {membership} waitDelivery = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
-- member records are not deleted to keep history
- members <- getMembers vr
+ members <- getMembers cxt
deleteMembersConnections' user members waitDelivery
where
- getMembers vr
- | useRelays' gInfo, not (isRelay membership) = withStore' $ \db -> getGroupRelayMembers db vr user gInfo
- | otherwise = withStore' $ \db -> getGroupMembers db vr user gInfo
+ getMembers cxt
+ | useRelays' gInfo, not (isRelay membership) = withStore' $ \db -> getGroupRelayMembers db cxt user gInfo
+ | otherwise = withStore' $ \db -> getGroupMembers db cxt user gInfo
startDeliveryTaskWorkers :: CM ()
startDeliveryTaskWorkers = do
@@ -3774,20 +3778,20 @@ getDeliveryTaskWorker hasWork deliveryKey = do
runDeliveryTaskWorker :: AgentClient -> DeliveryWorkerKey -> Worker -> CM ()
runDeliveryTaskWorker a deliveryKey Worker {doWork} = do
delay <- asks $ deliveryWorkerDelay . config
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
-- TODO [relays] in future may be required to read groupInfo and user on each iteration for up to date state
-- TODO - same for delivery jobs (runDeliveryJobWorker)
gInfo <- withStore $ \db -> do
user <- getUserByGroupId db groupId
- getGroupInfo db vr user groupId
+ getGroupInfo db cxt user groupId
forever $ do
unless (delay == 0) $ liftIO $ threadDelay' delay
lift $ waitForWork doWork
- runDeliveryTaskOperation vr gInfo
+ runDeliveryTaskOperation cxt gInfo
where
(groupId, workerScope) = deliveryKey
- runDeliveryTaskOperation :: VersionRangeChat -> GroupInfo -> CM ()
- runDeliveryTaskOperation vr gInfo = do
+ runDeliveryTaskOperation :: StoreCxt -> GroupInfo -> CM ()
+ runDeliveryTaskOperation cxt gInfo = do
withWork_ a doWork (withStore' $ \db -> getNextDeliveryTask db deliveryKey) $ \task ->
processDeliveryTask task
`catchAllErrors` \e -> do
@@ -3803,7 +3807,7 @@ runDeliveryTaskWorker a deliveryKey Worker {doWork} = do
withStore' $ \db -> setDeliveryTaskErrStatus db (deliveryTaskId task) "relay inactive"
| otherwise ->
withWorkItems a doWork (withStore' $ \db -> getNextDeliveryTasks db gInfo task) $ \nextTasks -> do
- let (body, acceptedTasks, largeTasks) = batchDeliveryTasks1 vr maxEncodedMsgLength nextTasks
+ let (body, acceptedTasks, largeTasks) = batchDeliveryTasks1 (vr cxt) maxEncodedMsgLength nextTasks
senderGMIds = S.toList . S.fromList $ map (\MessageDeliveryTask {senderGMId} -> senderGMId) acceptedTasks
withStore' $ \db -> do
createMsgDeliveryJob db gInfo jobScope senderGMIds body
@@ -3862,19 +3866,19 @@ encodeMemberNew vr gInfo member = case encodeChatMessage maxBatchElementSize cha
runDeliveryJobWorker :: AgentClient -> DeliveryWorkerKey -> Worker -> CM ()
runDeliveryJobWorker a deliveryKey Worker {doWork} = do
delay <- asks $ deliveryWorkerDelay . config
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
(user, gInfo) <- withStore $ \db -> do
user <- getUserByGroupId db groupId
- gInfo <- getGroupInfo db vr user groupId
+ gInfo <- getGroupInfo db cxt user groupId
pure (user, gInfo)
forever $ do
unless (delay == 0) $ liftIO $ threadDelay' delay
lift $ waitForWork doWork
- runDeliveryJobOperation vr user gInfo
+ runDeliveryJobOperation cxt user gInfo
where
(groupId, workerScope) = deliveryKey
- runDeliveryJobOperation :: VersionRangeChat -> User -> GroupInfo -> CM ()
- runDeliveryJobOperation vr user gInfo = do
+ runDeliveryJobOperation :: StoreCxt -> User -> GroupInfo -> CM ()
+ runDeliveryJobOperation cxt user gInfo = do
withWork_ a doWork (withStore' $ \db -> getNextDeliveryJob db deliveryKey) $ \job ->
processDeliveryJob job
`catchAllErrors` \e -> do
@@ -3914,7 +3918,7 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
senders <- withStore' $ \db ->
fmap catMaybes . forM senderGMIds $ \sId ->
fmap (join . eitherToMaybe) . runExceptT $ do
- sender <- getNonRemovedMemberById db vr user sId
+ sender <- getNonRemovedMemberById db cxt user sId
-- owners are already known to every member (group link + owner-intro in introduceInChannel),
-- so we never disseminate their profile (redundant, and races with joins re-announcing the owner)
if memberRole' sender == GROwner
@@ -3932,7 +3936,7 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
then pure (body, [], [], [])
else do
-- all members' profiles disseminate; privileged key/role come from the roster, not here
- let (encoderErrs, validLabeled) = partitionEithers [(\bs -> (s, bs)) <$> encodeMemberNew vr gInfo s | (s, _) <- senders]
+ let (encoderErrs, validLabeled) = partitionEithers [(\bs -> (s, bs)) <$> encodeMemberNew (vr cxt) gInfo s | (s, _) <- senders]
(extBody', inBody, overflowLabeled, large1) = batchProfilesWithBody maxEncodedMsgLength body validLabeled
(overflowBatches', large2) = batchProfiles maxEncodedMsgLength overflowLabeled
packerErrs = [ChatError (CEInternalError $ "oversized profile element for member " <> show (groupMemberId' s)) | s <- large1 <> large2]
@@ -3950,7 +3954,7 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
where
sendLoop :: Int -> Maybe GroupMemberId -> Map GroupMemberId ByteString -> [(Int, (ByteString, [GroupMember]))] -> [GroupMember] -> ByteString -> [GroupMember] -> CM ()
sendLoop bucketSize cursorGMId_ senderVec overflowWithIds inBodySenders extBody activeSenders = do
- mems <- withStore' $ \db -> getGroupMembersByCursor db vr user gInfo cursorGMId_ singleSenderGMId_ bucketSize
+ mems <- withStore' $ \db -> getGroupMembersByCursor db cxt user gInfo cursorGMId_ singleSenderGMId_ bucketSize
unless (null mems) $ do
let msgReqs = buildMsgReqs mems
unless (null msgReqs) $ void $ withAgent (`sendMessages` msgReqs)
@@ -3995,7 +3999,7 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
Nothing -> True
DJSMemberSupport scopeGMId -> do
-- for member support scope we just load all recipients in one go, without cursor
- modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
+ modMs <- withStore' $ \db -> getGroupModerators db cxt user gInfo
let moderatorFilter m =
memberCurrent m
&& maxVersion (memberChatVRange m) >= groupKnockingVersion
@@ -4005,14 +4009,14 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
if Just scopeGMId == singleSenderGMId_
then pure modMs'
else do
- scopeMem <- withStore $ \db -> getGroupMemberById db vr user scopeGMId
+ scopeMem <- withStore $ \db -> getGroupMemberById db cxt user scopeGMId
pure $ scopeMem : modMs'
unless (null mems) $ deliver body mems
-- fully connected group
| otherwise = case singleSenderGMId_ of
Nothing -> throwChatError $ CEInternalError "delivery job worker: singleSenderGMId is required when not using relays"
Just sId -> do
- sender <- withStore $ \db -> getGroupMemberById db vr user sId
+ sender <- withStore $ \db -> getGroupMemberById db cxt user sId
ms <- buildMemberList sender
unless (null ms) $ deliver body ms
where
@@ -4022,14 +4026,14 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
let introducedMemsIdxs = getRelationsIndexes MRIntroduced vec
case jobScope of
DJSGroup {jobSpec} -> do
- ms <- withStore' $ \db -> getGroupMembersByIndexes db vr user gInfo introducedMemsIdxs
+ ms <- withStore' $ \db -> getGroupMembersByIndexes db cxt user gInfo introducedMemsIdxs
pure $ filter shouldForwardTo ms
where
shouldForwardTo m
| jobSpecImpliedPending jobSpec = memberCurrentOrPending m
| otherwise = memberCurrent m
DJSMemberSupport scopeGMId -> do
- ms <- withStore' $ \db -> getSupportScopeMembersByIndexes db vr user gInfo scopeGMId introducedMemsIdxs
+ ms <- withStore' $ \db -> getSupportScopeMembersByIndexes db cxt user gInfo scopeGMId introducedMemsIdxs
pure $ filter shouldForwardTo ms
where
shouldForwardTo m = groupMemberId' m == scopeGMId || currentModerator m
@@ -4080,7 +4084,7 @@ getRelayRequestWorker hasWork = do
runRelayRequestWorker :: AgentClient -> Worker -> CM ()
runRelayRequestWorker a Worker {doWork} = do
- vr <- chatVersionRange
+ cxt <- chatStoreCxt
(user, uclId) <- withStore $ \db -> do
user <- getRelayUser db
UserContactLink {userContactLinkId} <- getUserAddress db user
@@ -4088,10 +4092,10 @@ runRelayRequestWorker a Worker {doWork} = do
delayThreads <- liftIO TM.emptyIO
forever $ do
lift $ waitForWork doWork
- runRelayRequestOperation delayThreads vr user uclId
+ runRelayRequestOperation delayThreads cxt user uclId
where
- runRelayRequestOperation :: TM.TMap GroupId (TMVar (Weak ThreadId)) -> VersionRangeChat -> User -> Int64 -> CM ()
- runRelayRequestOperation delayThreads vr user uclId =
+ runRelayRequestOperation :: TM.TMap GroupId (TMVar (Weak ThreadId)) -> StoreCxt -> User -> Int64 -> CM ()
+ runRelayRequestOperation delayThreads cxt user uclId =
withWork_ a doWork getReadyRelayRequest $
\(groupId, rrd) -> do
ChatConfig {relayRequestExpiry} <- asks config
@@ -4140,7 +4144,7 @@ runRelayRequestWorker a Worker {doWork} = do
processRelayRequest :: GroupId -> RelayRequestData -> CM ()
processRelayRequest groupId rrd = do
(gInfo, groupLink_) <- withStore $ \db -> do
- gInfo <- getGroupInfo db vr user groupId
+ gInfo <- getGroupInfo db cxt user groupId
groupLink_ <- liftIO $ runExceptT $ getGroupLink db user gInfo
pure (gInfo, groupLink_)
-- Check if relay link already exists (recovery case)
@@ -4168,7 +4172,7 @@ runRelayRequestWorker a Worker {doWork} = do
gInfo' <- withStore $ \db -> do
void $ updateGroupProfile db user gInfo gp
updateRelayGroupKeys db user gInfo pg rootKey memberPrivKey owners
- getGroupInfo db vr user groupId
+ getGroupInfo db cxt user groupId
pure (gInfo', sLnk)
where
validateGroupProfile :: GroupProfile -> CM ()
@@ -4200,5 +4204,5 @@ runRelayRequestWorker a Worker {doWork} = do
pure (sigKeys, sLnk)
acceptOwnerConnection :: RelayRequestData -> GroupInfo -> ShortLinkContact -> CM ()
acceptOwnerConnection RelayRequestData {relayInvId, reqChatVRange} gi relayLink = do
- ownerMember <- withStore $ \db -> getHostMember db vr user groupId
+ ownerMember <- withStore $ \db -> getHostMember db cxt user groupId
void $ acceptRelayJoinRequestAsync user uclId gi ownerMember relayInvId reqChatVRange relayLink
diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs
index ac4583b9b9..7217ce96a8 100644
--- a/src/Simplex/Chat/Store/Connections.hs
+++ b/src/Simplex/Chat/Store/Connections.hs
@@ -74,8 +74,8 @@ getChatLockEntity db agentConnId = do
-- TODO consider whether ConnFailed connections should be excluded:
-- - from receiving: getConnectionEntity, getContactConnEntityByConnReqHash
-- - from subscribing: getContactConnsToSub, getUCLConnsToSub, getMemberConnsToSub, getPendingConnsToSub
-getConnectionEntity :: DB.Connection -> VersionRangeChat -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
-getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
+getConnectionEntity :: DB.Connection -> StoreCxt -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
+getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
c@Connection {connType, entityId} <- getConnection_
case entityId of
Nothing ->
@@ -90,7 +90,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
where
getConnection_ :: ExceptT StoreError IO Connection
getConnection_ = ExceptT $ do
- firstRow (toConnection vr) (SEConnectionNotFound agentConnId) $
+ firstRow (toConnection cxt) (SEConnectionNotFound agentConnId) $
DB.query
db
[sql|
@@ -172,7 +172,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
liftIO $ bitraverse (addGroupChatTags db) pure gm
toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember)
toGroupAndMember c (groupInfoRow :. memberRow) =
- let groupInfo = toGroupInfo vr userContactId [] groupInfoRow
+ let groupInfo = toGroupInfo cxt userContactId [] groupInfoRow
member = toGroupMember userContactId memberRow
in (groupInfo, (member :: GroupMember) {activeConn = Just c})
getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
@@ -191,17 +191,17 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
userContact_ _ = Left SEUserContactLinkNotFound
-getConnectionEntityByConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
-getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
+getConnectionEntityByConnReq :: DB.Connection -> StoreCxt -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
+getConnectionEntityByConnReq db cxt user@User {userId} (cReqSchema1, cReqSchema2) = do
connId_ <-
maybeFirstRow fromOnly $
DB.query db "SELECT agent_conn_id FROM connections WHERE user_id = ? AND conn_req_inv IN (?,?) LIMIT 1" (userId, cReqSchema1, cReqSchema2)
- maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
+ maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db cxt user) connId_
-getConnectionEntityViaShortLink :: DB.Connection -> VersionRangeChat -> User -> ShortLinkInvitation -> IO (Maybe (ConnReqInvitation, ConnectionEntity))
-getConnectionEntityViaShortLink db vr user@User {userId} shortLink = fmap eitherToMaybe $ runExceptT $ do
+getConnectionEntityViaShortLink :: DB.Connection -> StoreCxt -> User -> ShortLinkInvitation -> IO (Maybe (ConnReqInvitation, ConnectionEntity))
+getConnectionEntityViaShortLink db cxt user@User {userId} shortLink = fmap eitherToMaybe $ runExceptT $ do
(cReq, connId) <- ExceptT getConnReqConnId
- (cReq,) <$> getConnectionEntity db vr user connId
+ (cReq,) <$> getConnectionEntity db cxt user connId
where
getConnReqConnId =
firstRow' toConnReqConnId (SEInternalError "connection not found") $
@@ -222,8 +222,8 @@ getConnectionEntityViaShortLink db vr user@User {userId} shortLink = fmap either
-- multiple connections can have same via_contact_uri_hash if request was repeated;
-- this function searches for latest connection with contact so that "known contact" plan would be chosen;
-- deleted connections are filtered out to allow re-connecting via same contact address
-getContactConnEntityByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
-getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2) = do
+getContactConnEntityByConnReqHash :: DB.Connection -> StoreCxt -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
+getContactConnEntityByConnReqHash db cxt user@User {userId} (cReqHash1, cReqHash2) = do
connId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -240,7 +240,7 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2
) c
|]
(userId, cReqHash1, cReqHash2, ConnDeleted)
- maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
+ maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db cxt user) connId_
getContactConnsToSub :: DB.Connection -> User -> Bool -> IO [ConnId]
getContactConnsToSub db User {userId} filterToSubscribe =
diff --git a/src/Simplex/Chat/Store/ContactRequest.hs b/src/Simplex/Chat/Store/ContactRequest.hs
index 1e0ca8bdc5..27cb970b73 100644
--- a/src/Simplex/Chat/Store/ContactRequest.hs
+++ b/src/Simplex/Chat/Store/ContactRequest.hs
@@ -49,7 +49,7 @@ import Database.SQLite.Simple.QQ (sql)
createOrUpdateContactRequest ::
DB.Connection ->
TVar ChaChaDRG ->
- VersionRangeChat ->
+ StoreCxt ->
User ->
Int64 ->
UserContactLink ->
@@ -65,7 +65,7 @@ createOrUpdateContactRequest ::
createOrUpdateContactRequest
db
gVar
- vr
+ cxt
user@User {userId, userContactId}
uclId
UserContactLink {addressSettings = AddressSettings {businessAddress}}
@@ -89,7 +89,7 @@ createOrUpdateContactRequest
Nothing ->
liftIO (getAcceptedBusinessChat xContactId) >>= \case
Just gInfo@GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do
- clientMember <- getGroupMemberByMemberId db vr user gInfo customerId
+ clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId
cr <- liftIO $ getContactRequestByXContactId xContactId
pure $ RSAcceptedRequest cr (REBusinessChat gInfo clientMember)
Just GroupInfo {businessChat = Nothing} -> throwError SEInvalidBusinessChatContactRequest
@@ -104,7 +104,7 @@ createOrUpdateContactRequest
getAcceptedContact :: XContactId -> IO (Maybe Contact)
getAcceptedContact xContactId = do
ct_ <-
- maybeFirstRow (toContact vr user []) $
+ maybeFirstRow (toContact cxt user []) $
DB.query
db
[sql|
@@ -128,7 +128,7 @@ createOrUpdateContactRequest
getAcceptedBusinessChat :: XContactId -> IO (Maybe GroupInfo)
getAcceptedBusinessChat xContactId = do
g_ <-
- maybeFirstRow (toGroupInfo vr userContactId []) $
+ maybeFirstRow (toGroupInfo cxt userContactId []) $
DB.query
db
(groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
@@ -200,12 +200,12 @@ createOrUpdateContactRequest
"UPDATE contact_requests SET contact_id = ? WHERE contact_request_id = ?"
(contactId, contactRequestId)
ucr <- getContactRequest db user contactRequestId
- ct <- getContact db vr user contactId
+ ct <- getContact db cxt user contactId
pure $ RSCurrentRequest Nothing ucr (Just $ REContact ct)
createBusinessChat = do
let groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs $ preferences' user
(gInfo@GroupInfo {groupId}, clientMember) <-
- createBusinessRequestGroup db vr gVar user cReqChatVRange profile profileId ldn groupPreferences
+ createBusinessRequestGroup db cxt gVar user cReqChatVRange profile profileId ldn groupPreferences
liftIO $
DB.execute
db
@@ -278,13 +278,13 @@ createOrUpdateContactRequest
getRequestEntity UserContactRequest {contactRequestId, contactId_, businessGroupId_} =
case (contactId_, businessGroupId_) of
(Just contactId, Nothing) -> do
- ct <- getContact db vr user contactId
+ ct <- getContact db cxt user contactId
pure $ Just (REContact ct)
(Nothing, Just businessGroupId) -> do
- gInfo <- getGroupInfo db vr user businessGroupId
+ gInfo <- getGroupInfo db cxt user businessGroupId
case gInfo of
GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do
- clientMember <- getGroupMemberByMemberId db vr user gInfo customerId
+ clientMember <- getGroupMemberByMemberId db cxt user gInfo customerId
pure $ Just (REBusinessChat gInfo clientMember)
_ -> throwError SEInvalidBusinessChatContactRequest
(Nothing, Nothing) -> pure Nothing
diff --git a/src/Simplex/Chat/Store/Delivery.hs b/src/Simplex/Chat/Store/Delivery.hs
index 75345e5e86..5e2e45f278 100644
--- a/src/Simplex/Chat/Store/Delivery.hs
+++ b/src/Simplex/Chat/Store/Delivery.hs
@@ -348,8 +348,8 @@ updateDeliveryJobStatus_ db jobId status errReason_ = do
(status, errReason_, currentTs, jobId)
-- TODO [relays] possible improvement is to prioritize owners and "active" members
-getGroupMembersByCursor :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe GroupMemberId -> Maybe GroupMemberId -> Int -> IO [GroupMember]
-getGroupMembersByCursor db vr user@User {userContactId} GroupInfo {groupId} cursorGMId_ singleSenderGMId_ count = do
+getGroupMembersByCursor :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe GroupMemberId -> Maybe GroupMemberId -> Int -> IO [GroupMember]
+getGroupMembersByCursor db cxt user@User {userContactId} GroupInfo {groupId} cursorGMId_ singleSenderGMId_ count = do
gmIds :: [Int64] <-
map fromOnly <$> case cursorGMId_ of
Nothing ->
@@ -367,13 +367,13 @@ getGroupMembersByCursor db vr user@User {userContactId} GroupInfo {groupId} curs
:. (cursorGMId, count)
)
#if defined(dbPostgres)
- map (toContactMember vr user) <$>
+ map (toContactMember cxt user) <$>
DB.query
db
- (groupMemberQuery <> " WHERE m.group_member_id IN ?")
+ (groupMemberQuery <> " WHERE m.group_member_id IN ? ORDER BY m.group_member_id ASC")
(Only (In gmIds))
#else
- rights <$> mapM (runExceptT . getGroupMemberById db vr user) gmIds
+ rights <$> mapM (runExceptT . getGroupMemberById db cxt user) gmIds
#endif
where
query =
diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs
index 60f898e52e..1c2f35f2bf 100644
--- a/src/Simplex/Chat/Store/Direct.hs
+++ b/src/Simplex/Chat/Store/Direct.hs
@@ -243,8 +243,8 @@ createRelayMemberConnectionAsync db user@User {userId} gInfo GroupMember {groupM
where
customUserProfileId_ = localProfileId <$> incognitoMembershipProfile gInfo
-createRelayTestConnection :: DB.Connection -> VersionRangeChat -> User -> ConnId -> ConnStatus -> VersionChat -> SubscriptionMode -> ExceptT StoreError IO Connection
-createRelayTestConnection db vr user@User {userId} agentConnId connStatus chatV subMode = do
+createRelayTestConnection :: DB.Connection -> StoreCxt -> User -> ConnId -> ConnStatus -> VersionChat -> SubscriptionMode -> ExceptT StoreError IO Connection
+createRelayTestConnection db cxt user@User {userId} agentConnId connStatus chatV subMode = do
currentTs <- liftIO getCurrentTime
liftIO $
DB.execute
@@ -261,7 +261,7 @@ createRelayTestConnection db vr user@User {userId} agentConnId connStatus chatV
:. (BI True, currentTs, currentTs)
)
connId <- liftIO $ insertedRowId db
- getConnectionById db vr user connId
+ getConnectionById db cxt user connId
updateConnLinkData :: DB.Connection -> User -> Connection -> ConnReqContact -> ConnReqUriHash -> Maybe GroupLinkId -> VersionChat -> PQSupport -> IO ()
updateConnLinkData db User {userId} Connection {connId} cReq cReqHash groupLinkId_ chatV pqSup = do
@@ -285,13 +285,13 @@ setPreparedGroupStartedConnection db groupId = do
"UPDATE groups SET conn_link_started_connection = ?, updated_at = ? WHERE group_id = ?"
(BI True, currentTs, groupId)
-getConnReqContactXContactId :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Either (Maybe Connection) Contact)
-getConnReqContactXContactId db vr user@User {userId} cReqHash1 cReqHash2 =
- getContactByConnReqHash db vr user cReqHash1 cReqHash2 >>= maybe (Left <$> getConnection) (pure . Right)
+getConnReqContactXContactId :: DB.Connection -> StoreCxt -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Either (Maybe Connection) Contact)
+getConnReqContactXContactId db cxt user@User {userId} cReqHash1 cReqHash2 =
+ getContactByConnReqHash db cxt user cReqHash1 cReqHash2 >>= maybe (Left <$> getConnection) (pure . Right)
where
getConnection :: IO (Maybe Connection)
getConnection =
- maybeFirstRow (toConnection vr) $
+ maybeFirstRow (toConnection cxt) $
DB.query
db
[sql|
@@ -305,10 +305,10 @@ getConnReqContactXContactId db vr user@User {userId} cReqHash1 cReqHash2 =
|]
(userId, cReqHash1, userId, cReqHash2)
-getContactByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Maybe Contact)
-getContactByConnReqHash db vr user@User {userId} cReqHash1 cReqHash2 = do
+getContactByConnReqHash :: DB.Connection -> StoreCxt -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Maybe Contact)
+getContactByConnReqHash db cxt user@User {userId} cReqHash1 cReqHash2 = do
ct <-
- maybeFirstRow (toContact vr user []) $
+ maybeFirstRow (toContact cxt user []) $
DB.query
db
[sql|
@@ -394,18 +394,18 @@ createIncognitoProfile db User {userId} p = do
createdAt <- getCurrentTime
createIncognitoProfile_ db userId createdAt p
-createPreparedContact :: DB.Connection -> VersionRangeChat -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
-createPreparedContact db vr user p connLinkToConnect welcomeSharedMsgId = do
+createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
+createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId = do
currentTs <- liftIO getCurrentTime
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
ctUserPreferences = newContactUserPrefs user p
contactId <- createContact_ db user p ctUserPreferences prepared "" currentTs
- getContact db vr user contactId
+ getContact db cxt user contactId
-updatePreparedContactUser :: DB.Connection -> VersionRangeChat -> User -> Contact -> User -> ExceptT StoreError IO Contact
+updatePreparedContactUser :: DB.Connection -> StoreCxt -> User -> Contact -> User -> ExceptT StoreError IO Contact
updatePreparedContactUser
db
- vr
+ cxt
user
Contact {contactId, localDisplayName = oldLDN, profile = profile@LocalProfile {profileId, displayName}}
newUser@User {userId = newUserId} = do
@@ -438,15 +438,15 @@ updatePreparedContactUser
|]
(newUserId, currentTs, contactId)
safeDeleteLDN db user oldLDN
- getContact db vr newUser contactId
+ getContact db cxt newUser contactId
-createDirectContact :: DB.Connection -> VersionRangeChat -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
-createDirectContact db vr user Connection {connId, localAlias} p = do
+createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
+createDirectContact db cxt user Connection {connId, localAlias} p = do
currentTs <- liftIO getCurrentTime
let ctUserPreferences = newContactUserPrefs user p
contactId <- createContact_ db user p ctUserPreferences Nothing localAlias currentTs
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
- getContact db vr user contactId
+ getContact db cxt user contactId
deleteContactConnections :: DB.Connection -> User -> Contact -> IO ()
deleteContactConnections db User {userId} Contact {contactId} = do
@@ -500,13 +500,13 @@ deleteContactWithoutGroups db user@User {userId} ct@Contact {contactId, localDis
deleteUnusedIncognitoProfileById_ db user profileId
-- TODO remove in future versions: only used for legacy contact cleanup
-getDeletedContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
-getDeletedContacts db vr user@User {userId} = do
+getDeletedContacts :: DB.Connection -> StoreCxt -> User -> IO [Contact]
+getDeletedContacts db cxt user@User {userId} = do
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 1" (Only userId)
- rights <$> mapM (runExceptT . getDeletedContact db vr user) contactIds
+ rights <$> mapM (runExceptT . getDeletedContact db cxt user) contactIds
-getDeletedContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
-getDeletedContact db vr user contactId = getContact_ db vr user contactId True
+getDeletedContact :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO Contact
+getDeletedContact db cxt user contactId = getContact_ db cxt user contactId True
deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO ()
deleteContactProfile_ db userId contactId =
@@ -756,15 +756,15 @@ updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt
(newName, updatedAt, userId, contactId)
safeDeleteLDN db user displayName
-getContactByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO Contact
-getContactByName db vr user localDisplayName = do
+getContactByName :: DB.Connection -> StoreCxt -> User -> ContactName -> ExceptT StoreError IO Contact
+getContactByName db cxt user localDisplayName = do
cId <- getContactIdByName db user localDisplayName
- getContact db vr user cId
+ getContact db cxt user cId
-getUserContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
-getUserContacts db vr user@User {userId} = do
+getUserContacts :: DB.Connection -> StoreCxt -> User -> IO [Contact]
+getUserContacts db cxt user@User {userId} = do
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Only userId)
- contacts <- rights <$> mapM (runExceptT . getContact db vr user) contactIds
+ contacts <- rights <$> mapM (runExceptT . getContact db cxt user) contactIds
pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts
getUserContactLinkIdByCReq :: DB.Connection -> Int64 -> ExceptT StoreError IO (Maybe Int64)
@@ -890,22 +890,22 @@ getContactIdByName db User {userId} cName =
ExceptT . firstRow fromOnly (SEContactNotFoundByName cName) $
DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND local_display_name = ? AND deleted = 0" (userId, cName)
-getContactViaShortLinkToConnect :: forall c. ConnectionModeI c => DB.Connection -> VersionRangeChat -> User -> ConnShortLink c -> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
-getContactViaShortLinkToConnect db vr user@User {userId} shortLink = do
+getContactViaShortLinkToConnect :: forall c. ConnectionModeI c => DB.Connection -> StoreCxt -> User -> ConnShortLink c -> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
+getContactViaShortLinkToConnect db cxt user@User {userId} shortLink = do
liftIO (maybeFirstRow id $ DB.query db "SELECT contact_id, conn_full_link_to_connect FROM contacts WHERE user_id = ? AND conn_short_link_to_connect = ?" (userId, shortLink)) >>= \case
Just (ctId :: Int64, Just (ACR cMode cReq)) ->
case testEquality cMode (sConnectionMode @c) of
- Just Refl -> Just . (cReq,) <$> getContact db vr user ctId
+ Just Refl -> Just . (cReq,) <$> getContact db cxt user ctId
Nothing -> pure Nothing
_ -> pure Nothing
-getContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
-getContact db vr user contactId = getContact_ db vr user contactId False
+getContact :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO Contact
+getContact db cxt user contactId = getContact_ db cxt user contactId False
-getContact_ :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
-getContact_ db vr user@User {userId} contactId deleted = do
+getContact_ :: DB.Connection -> StoreCxt -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
+getContact_ db cxt user@User {userId} contactId deleted = do
chatTags <- liftIO $ getDirectChatTags db contactId
- ExceptT . firstRow (toContact vr user chatTags) (SEContactNotFound contactId) $
+ ExceptT . firstRow (toContact cxt user chatTags) (SEContactNotFound contactId) $
DB.query
db
[sql|
@@ -932,8 +932,8 @@ getUserByContactRequestId db contactRequestId =
ExceptT . firstRow toUser (SEUserNotFoundByContactRequestId contactRequestId) $
DB.query db (userQuery <> " JOIN contact_requests cr ON cr.user_id = u.user_id WHERE cr.contact_request_id = ?") (Only contactRequestId)
-getContactConnections :: DB.Connection -> VersionRangeChat -> UserId -> Contact -> IO [Connection]
-getContactConnections db vr userId Contact {contactId} =
+getContactConnections :: DB.Connection -> StoreCxt -> UserId -> Contact -> IO [Connection]
+getContactConnections db cxt userId Contact {contactId} =
connections =<< liftIO getConnections_
where
getConnections_ =
@@ -950,11 +950,11 @@ getContactConnections db vr userId Contact {contactId} =
|]
(userId, userId, contactId)
connections [] = pure []
- connections rows = pure $ map (toConnection vr) rows
+ connections rows = pure $ map (toConnection cxt) rows
-getConnectionById :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Connection
-getConnectionById db vr User {userId} connId = ExceptT $ do
- firstRow (toConnection vr) (SEConnectionNotFoundById connId) $
+getConnectionById :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO Connection
+getConnectionById db cxt User {userId} connId = ExceptT $ do
+ firstRow (toConnection cxt) (SEConnectionNotFoundById connId) $
DB.query
db
[sql|
diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs
index 951fce8958..5289a3b304 100644
--- a/src/Simplex/Chat/Store/Files.hs
+++ b/src/Simplex/Chat/Store/Files.hs
@@ -570,19 +570,19 @@ getRcvFileTransfer_ db userId fileId = do
Just fp -> pure fp
cancelled = maybe False unBI cancelled_
-acceptRcvInlineFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
-acceptRcvInlineFT db vr user fileId filePath = do
+acceptRcvInlineFT :: DB.Connection -> StoreCxt -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
+acceptRcvInlineFT db cxt user fileId filePath = do
liftIO $ acceptRcvFT_ db user fileId filePath False (Just IFMOffer) =<< getCurrentTime
- getChatItemByFileId db vr user fileId
+ getChatItemByFileId db cxt user fileId
startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Maybe InlineFileMode -> IO ()
startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline =
acceptRcvFT_ db user fileId filePath False rcvFileInline =<< getCurrentTime
-xftpAcceptRcvFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> Bool -> ExceptT StoreError IO AChatItem
-xftpAcceptRcvFT db vr user fileId filePath userApprovedRelays = do
+xftpAcceptRcvFT :: DB.Connection -> StoreCxt -> User -> FileTransferId -> FilePath -> Bool -> ExceptT StoreError IO AChatItem
+xftpAcceptRcvFT db cxt user fileId filePath userApprovedRelays = do
liftIO $ acceptRcvFT_ db user fileId filePath userApprovedRelays Nothing =<< getCurrentTime
- getChatItemByFileId db vr user fileId
+ getChatItemByFileId db cxt user fileId
acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Bool -> Maybe InlineFileMode -> UTCTime -> IO ()
acceptRcvFT_ db User {userId} fileId filePath userApprovedRelays rcvFileInline currentTs = do
@@ -860,9 +860,9 @@ getLocalCryptoFile db userId fileId sent =
pure $ CryptoFile filePath fileCryptoArgs
_ -> throwError $ SEFileNotFound fileId
-updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRangeChat -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
-updateDirectCIFileStatus db vr user fileId fileStatus = do
- aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db vr user fileId
+updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> StoreCxt -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
+updateDirectCIFileStatus db cxt user fileId fileStatus = do
+ aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db cxt user fileId
case (cType, testEquality d $ msgDirection @d) of
(SCTDirect, Just Refl) -> do
liftIO $ updateCIFileStatus db user fileId fileStatus
diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs
index d1955d9f59..48b4cffcbc 100644
--- a/src/Simplex/Chat/Store/Groups.hs
+++ b/src/Simplex/Chat/Store/Groups.hs
@@ -258,9 +258,9 @@ createGroupLink db gVar user@User {userId} groupInfo@GroupInfo {groupId, localDi
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff
getGroupLink db user groupInfo
-getGroupLinkConnection :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ExceptT StoreError IO Connection
-getGroupLinkConnection db vr User {userId} groupInfo@GroupInfo {groupId} =
- ExceptT . firstRow (toConnection vr) (SEGroupLinkNotFound groupInfo) $
+getGroupLinkConnection :: DB.Connection -> StoreCxt -> User -> GroupInfo -> ExceptT StoreError IO Connection
+getGroupLinkConnection db cxt User {userId} groupInfo@GroupInfo {groupId} =
+ ExceptT . firstRow (toConnection cxt) (SEGroupLinkNotFound groupInfo) $
DB.query
db
[sql|
@@ -355,8 +355,8 @@ setGroupLinkShortLink db gLnk@GroupLink {userContactLinkId, connLinkContact = CC
pure gLnk {connLinkContact = CCLink connFullLink (Just shortLink), shortLinkDataSet = True, shortLinkLargeDataSet = BoolDef True}
-- | creates completely new group with a single member - the current user
-createNewGroup :: DB.Connection -> VersionRangeChat -> User -> GroupProfile -> Maybe Profile -> Bool -> MemberId -> Maybe GroupKeys -> Maybe Int64 -> ExceptT StoreError IO GroupInfo
-createNewGroup db vr user@User {userId} groupProfile incognitoProfile useRelays memberId groupKeys publicMemberCount_ = ExceptT $ do
+createNewGroup :: DB.Connection -> StoreCxt -> User -> GroupProfile -> Maybe Profile -> Bool -> MemberId -> Maybe GroupKeys -> Maybe Int64 -> ExceptT StoreError IO GroupInfo
+createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays memberId groupKeys publicMemberCount_ = ExceptT $ do
let GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission} = groupProfile
(groupType_, groupLink_, publicGroupId_) = case publicGroup of
Just PublicGroupProfile {groupType, groupLink, publicGroupId} -> (Just groupType, Just groupLink, Just publicGroupId)
@@ -401,7 +401,7 @@ createNewGroup db vr user@User {userId} groupProfile incognitoProfile useRelays
)
insertedRowId db
let memberPubKey = C.publicKey . memberPrivKey <$> groupKeys
- membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole memberId GROwner) GCUserMember GSMemCreator IBUser customUserProfileId memberPubKey currentTs vr
+ membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole memberId GROwner) GCUserMember GSMemCreator IBUser customUserProfileId memberPubKey currentTs (vr cxt)
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure
GroupInfo
@@ -432,13 +432,13 @@ createNewGroup db vr user@User {userId} groupProfile incognitoProfile useRelays
}
-- | 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 :: DB.Connection -> StoreCxt -> 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 {peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile, business} incognitoProfileId = do
+createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, activeConn = Just Connection {peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile, business} incognitoProfileId = do
liftIO getInvitationGroupId_ >>= \case
Nothing -> createGroupInvitation_
Just gId -> do
- gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db vr user gId
+ gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db cxt user gId
hostId <- getHostMemberId_ db user gId
let GroupMember {groupMemberId, memberId, memberRole} = membership
MemberIdRole {memberId = invMemberId, memberRole = invMemberRole} = invitedMember
@@ -477,9 +477,9 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|]
((profileId, localDisplayName, connRequest, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
insertedRowId db
- let hostVRange = adjustedMemberVRange vr peerChatVRange
+ let hostVRange = adjustedMemberVRange (vr cxt) peerChatVRange
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing Nothing currentTs hostVRange
- membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId Nothing currentTs vr
+ membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId Nothing currentTs (vr cxt)
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure
( GroupInfo
@@ -622,8 +622,8 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {
DB.execute db "DELETE FROM contacts WHERE contact_id = ?" (Only contactId)
DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
-createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember)
-createPreparedGroup db gVar vr user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ = do
+createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> StoreCxt -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember)
+createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ = do
currentTs <- liftIO getCurrentTime
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
(groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs
@@ -637,11 +637,11 @@ createPreparedGroup db gVar vr user@User {userId, userContactId} groupProfile bu
else pure $ MemberId $ encodeUtf8 groupLDN <> "_user_unknown_id"
let userMember = MemberIdRole userMemberId userMemberRole
-- TODO [member keys] user key must be included here. Should key be added when group is prepared?
- membership <- createContactMemberInv_ db user groupId hostMemberId_ user userMember GCUserMember GSMemUnknown IBUnknown Nothing Nothing currentTs vr
- hostMember_ <- forM hostMemberId_ $ getGroupMember db vr user groupId
+ membership <- createContactMemberInv_ db user groupId hostMemberId_ user userMember GCUserMember GSMemUnknown IBUnknown Nothing Nothing currentTs (vr cxt)
+ hostMember_ <- forM hostMemberId_ $ getGroupMember db cxt user groupId
forM_ hostMember_ $ \hostMember ->
when business $ liftIO $ setGroupBusinessChatInfo groupId membership hostMember
- g <- getGroupInfo db vr user groupId
+ g <- getGroupInfo db cxt user groupId
pure (g, hostMember_)
where
insertHost_ currentTs groupId groupLDN = do
@@ -681,13 +681,13 @@ updateBusinessChatInfo db groupId businessChatInfo =
|]
(businessChatInfoRow businessChatInfo :. (Only groupId))
-updatePreparedGroupUser :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe GroupMember -> User -> ExceptT StoreError IO GroupInfo
-updatePreparedGroupUser db vr user gInfo@GroupInfo {groupId, membership} hostMember_ newUser@User {userId = newUserId} = do
+updatePreparedGroupUser :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe GroupMember -> User -> ExceptT StoreError IO GroupInfo
+updatePreparedGroupUser db cxt user gInfo@GroupInfo {groupId, membership} hostMember_ newUser@User {userId = newUserId} = do
currentTs <- liftIO getCurrentTime
updateGroup gInfo currentTs
liftIO $ updateMembership membership currentTs
forM_ hostMember_ $ \hostMember -> updateHostMember hostMember currentTs
- getGroupInfo db vr newUser groupId
+ getGroupInfo db cxt newUser groupId
where
updateGroup GroupInfo {localDisplayName = oldGroupLDN, groupProfile = GroupProfile {displayName = groupDisplayName}} currentTs =
ExceptT . withLocalDisplayName db newUserId groupDisplayName $ \newGroupLDN -> runExceptT $ do
@@ -753,21 +753,21 @@ updatePreparedGroupUser db vr user gInfo@GroupInfo {groupId, membership} hostMem
(newUserId, currentTs, hostProfileId)
safeDeleteLDN db user oldHostLDN
-updatePreparedUserAndHostMembersInvited :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
-updatePreparedUserAndHostMembersInvited db vr user gInfo hostMember GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
+updatePreparedUserAndHostMembersInvited :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
+updatePreparedUserAndHostMembersInvited db cxt user gInfo hostMember GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
let fromMemberProfile = profileFromName fromMemberName
initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted
- updatePreparedUserAndHostMembers' db vr user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile business initialStatus
+ updatePreparedUserAndHostMembers' db cxt user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile business initialStatus
-updatePreparedUserAndHostMembersRejected :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
-updatePreparedUserAndHostMembersRejected db vr user gInfo hostMember GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
+updatePreparedUserAndHostMembersRejected :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
+updatePreparedUserAndHostMembersRejected db cxt user gInfo hostMember GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
let fromMemberProfile = profileFromName $ nameFromMemberId memberId
- updatePreparedUserAndHostMembers' db vr user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected
+ updatePreparedUserAndHostMembers' db cxt user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected
-updatePreparedUserAndHostMembers' :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
+updatePreparedUserAndHostMembers' :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembers'
db
- vr
+ cxt
user
gInfo@GroupInfo {groupId, membership, groupProfile = gp, businessChat}
hostMember
@@ -786,7 +786,7 @@ updatePreparedUserAndHostMembers'
void $ updateGroupProfile db user gInfo groupProfile
when (isJust businessChat && isJust business) $
liftIO $ updateBusinessChatInfo db groupId business
- gInfo' <- getGroupInfo db vr user groupId
+ gInfo' <- getGroupInfo db cxt user groupId
pure (gInfo', hostMember')
where
updateUserMember currentTs = do
@@ -817,23 +817,23 @@ updatePreparedUserAndHostMembers'
WHERE group_member_id = ?
|]
(memberId, memberRole, currentTs, gmId)
- getGroupMemberById db vr user gmId
+ getGroupMemberById db cxt user gmId
-createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
-createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
+createGroupInvitedViaLink :: DB.Connection -> StoreCxt -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
+createGroupInvitedViaLink db cxt user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
let fromMemberProfile = profileFromName fromMemberName
initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted
- createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business initialStatus
+ createGroupViaLink' db cxt user conn fromMember fromMemberProfile invitedMember groupProfile business initialStatus
-createGroupRejectedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
-createGroupRejectedViaLink db vr user conn GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
+createGroupRejectedViaLink :: DB.Connection -> StoreCxt -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
+createGroupRejectedViaLink db cxt user conn GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
let fromMemberProfile = profileFromName $ nameFromMemberId memberId
- createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected
+ createGroupViaLink' db cxt user conn fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected
-createGroupViaLink' :: DB.Connection -> VersionRangeChat -> User -> Connection -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
+createGroupViaLink' :: DB.Connection -> StoreCxt -> User -> Connection -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupViaLink'
db
- vr
+ cxt
user@User {userId, userContactId}
Connection {connId, customUserProfileId}
fromMember
@@ -848,9 +848,9 @@ createGroupViaLink'
liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId)
-- using IBUnknown since host is created without contact
-- TODO [member keys] this is currently not used with public groups. If it needs to be used, member keys need to be added
- void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember membershipStatus IBUnknown customUserProfileId Nothing currentTs vr
+ void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember membershipStatus IBUnknown customUserProfileId Nothing currentTs (vr cxt)
liftIO $ setViaGroupLinkUri db groupId connId
- (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user hostMemberId
+ (,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user hostMemberId
where
insertHost_ currentTs groupId = do
(localDisplayName, profileId) <- createNewMemberProfile_ db user fromMemberProfile currentTs
@@ -911,10 +911,10 @@ setGroupInvitationChatItemId db User {userId} groupId chatItemId = do
-- TODO return the last connection that is ready, not any last connection
-- requires updating connection status
-getGroup :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO Group
-getGroup db vr user groupId = do
- gInfo <- getGroupInfo db vr user groupId
- members <- liftIO $ getGroupMembers db vr user gInfo
+getGroup :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO Group
+getGroup db cxt user groupId = do
+ gInfo <- getGroupInfo db cxt user groupId
+ members <- liftIO $ getGroupMembers db cxt user gInfo
pure $ Group gInfo members
deleteGroupChatItems :: DB.Connection -> User -> GroupInfo -> IO ()
@@ -1008,18 +1008,18 @@ deleteGroupProfile_ db userId groupId =
|]
(userId, groupId)
-getInProgressGroups :: DB.Connection -> VersionRangeChat -> User -> UTCTime -> IO [GroupInfo]
-getInProgressGroups db vr user@User {userId} createdAtCutoff = do
+getInProgressGroups :: DB.Connection -> StoreCxt -> User -> UTCTime -> IO [GroupInfo]
+getInProgressGroups db cxt user@User {userId} createdAtCutoff = do
groupIds <- map fromOnly <$>
DB.query
db
"SELECT group_id FROM groups WHERE user_id = ? AND creating_in_progress = 1 AND created_at <= ?"
(userId, createdAtCutoff)
- rights <$> mapM (runExceptT . getGroupInfo db vr user) groupIds
+ rights <$> mapM (runExceptT . getGroupInfo db cxt user) groupIds
-getBaseGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe Text -> IO [GroupInfo]
-getBaseGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
- map (toGroupInfo vr userContactId [])
+getBaseGroupDetails :: DB.Connection -> StoreCxt -> User -> Maybe ContactId -> Maybe Text -> IO [GroupInfo]
+getBaseGroupDetails db cxt User {userId, userContactId} _contactId_ search_ = do
+ map (toGroupInfo cxt userContactId [])
<$> DB.query db (groupInfoQuery <> " " <> condition) (userId, userContactId, search, search, search, search)
where
condition =
@@ -1047,22 +1047,22 @@ getContactGroupPreferences db User {userId} Contact {contactId} = do
|]
(userId, contactId)
-getGroupInfoByName :: DB.Connection -> VersionRangeChat -> User -> GroupName -> ExceptT StoreError IO GroupInfo
-getGroupInfoByName db vr user gName = do
+getGroupInfoByName :: DB.Connection -> StoreCxt -> User -> GroupName -> ExceptT StoreError IO GroupInfo
+getGroupInfoByName db cxt user gName = do
gId <- getGroupIdByName db user gName
- getGroupInfo db vr user gId
+ getGroupInfo db cxt user gId
-getGroupMember :: DB.Connection -> VersionRangeChat -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
-getGroupMember db vr user@User {userId} groupId groupMemberId =
- ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $
+getGroupMember :: DB.Connection -> StoreCxt -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
+getGroupMember db cxt user@User {userId} groupId groupMemberId =
+ ExceptT . firstRow (toContactMember cxt user) (SEGroupMemberNotFound groupMemberId) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
(groupId, groupMemberId, userId)
-getHostMember :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO GroupMember
-getHostMember db vr user groupId =
- ExceptT . firstRow (toContactMember vr user) (SEGroupHostMemberNotFound groupId) $
+getHostMember :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO GroupMember
+getHostMember db cxt user groupId =
+ ExceptT . firstRow (toContactMember cxt user) (SEGroupHostMemberNotFound groupId) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.member_category = ?")
@@ -1101,54 +1101,54 @@ toMentionedMember (groupMemberId, memberId, memberRole, displayName, localAlias)
let memberRef = Just CIMentionMember {groupMemberId, displayName, localAlias, memberRole}
in CIMention {memberId, memberRef}
-getGroupMemberById :: DB.Connection -> VersionRangeChat -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
-getGroupMemberById db vr user@User {userId} groupMemberId =
- ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $
+getGroupMemberById :: DB.Connection -> StoreCxt -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
+getGroupMemberById db cxt user@User {userId} groupMemberId =
+ ExceptT . firstRow (toContactMember cxt user) (SEGroupMemberNotFound groupMemberId) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ?")
(groupMemberId, userId)
-getNonRemovedMemberById :: DB.Connection -> VersionRangeChat -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
-getNonRemovedMemberById db vr user@User {userId} groupMemberId =
- ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $
+getNonRemovedMemberById :: DB.Connection -> StoreCxt -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
+getNonRemovedMemberById db cxt user@User {userId} groupMemberId =
+ ExceptT . firstRow (toContactMember cxt user) (SEGroupMemberNotFound groupMemberId) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ? AND m.member_status NOT IN (?,?,?,?)")
(groupMemberId, userId, GSMemRejected, GSMemRemoved, GSMemLeft, GSMemGroupDeleted)
-getGroupMemberByIndex :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Int64 -> ExceptT StoreError IO GroupMember
-getGroupMemberByIndex db vr user GroupInfo {groupId} indexInGroup =
- ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFoundByIndex indexInGroup) $
+getGroupMemberByIndex :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Int64 -> ExceptT StoreError IO GroupMember
+getGroupMemberByIndex db cxt user GroupInfo {groupId} indexInGroup =
+ ExceptT . firstRow (toContactMember cxt user) (SEGroupMemberNotFoundByIndex indexInGroup) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group = ?")
(groupId, indexInGroup)
-getSupportScopeMemberByIndex :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMemberId -> Int64 -> ExceptT StoreError IO GroupMember
-getSupportScopeMemberByIndex db vr user GroupInfo {groupId} scopeGMId indexInGroup =
- ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFoundByIndex indexInGroup) $
+getSupportScopeMemberByIndex :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMemberId -> Int64 -> ExceptT StoreError IO GroupMember
+getSupportScopeMemberByIndex db cxt user GroupInfo {groupId} scopeGMId indexInGroup =
+ ExceptT . firstRow (toContactMember cxt user) (SEGroupMemberNotFoundByIndex indexInGroup) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group = ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)")
(groupId, indexInGroup, GRModerator, GRAdmin, GROwner, scopeGMId)
-getGroupMemberByMemberId :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
-getGroupMemberByMemberId db vr user GroupInfo {groupId} memberId =
- ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFoundByMemberId memberId) $
+getGroupMemberByMemberId :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
+getGroupMemberByMemberId db cxt user GroupInfo {groupId} memberId =
+ ExceptT . firstRow (toContactMember cxt user) (SEGroupMemberNotFoundByMemberId memberId) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ?")
(groupId, memberId)
-getCreateUnknownGMByMemberId :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> ContactName -> GroupMemberRole -> Bool -> ExceptT StoreError IO (Maybe (GroupMember, Bool))
-getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownMemberRole allowCreate = do
- liftIO (runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case
+getCreateUnknownGMByMemberId :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberId -> ContactName -> GroupMemberRole -> Bool -> ExceptT StoreError IO (Maybe (GroupMember, Bool))
+getCreateUnknownGMByMemberId db cxt user gInfo memberId memberName unknownMemberRole allowCreate = do
+ liftIO (runExceptT $ getGroupMemberByMemberId db cxt user gInfo memberId) >>= \case
Right m -> pure $ Just (m, False)
Left (SEGroupMemberNotFoundByMemberId _)
| allowCreate -> do
let name = if T.null memberName then nameFromMemberId memberId else memberName
- m <- createNewUnknownGroupMember db vr user gInfo memberId name unknownMemberRole
+ m <- createNewUnknownGroupMember db cxt user gInfo memberId name unknownMemberRole
pure $ Just (m, True)
| otherwise -> pure Nothing
Left e -> throwError e
@@ -1167,43 +1167,43 @@ getGroupMemberIdViaMemberId db User {userId} GroupInfo {groupId} memberId =
"SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_id = ?"
(userId, groupId, memberId)
-getGroupMembers :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
-getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} =
- map (toContactMember vr user)
+getGroupMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
+getGroupMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} =
+ map (toContactMember cxt user)
<$> DB.query
db
(groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)")
(userId, groupId, userContactId)
-getGroupMembersByIndexes :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> [Int64] -> IO [GroupMember]
-getGroupMembersByIndexes db vr user gInfo indexesInGroup = do
+getGroupMembersByIndexes :: DB.Connection -> StoreCxt -> User -> GroupInfo -> [Int64] -> IO [GroupMember]
+getGroupMembersByIndexes db cxt user gInfo indexesInGroup = do
#if defined(dbPostgres)
let GroupInfo {groupId} = gInfo
- map (toContactMember vr user) <$>
+ map (toContactMember cxt user) <$>
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group IN ?")
(groupId, In indexesInGroup)
#else
- rights <$> mapM (runExceptT . getGroupMemberByIndex db vr user gInfo) indexesInGroup
+ rights <$> mapM (runExceptT . getGroupMemberByIndex db cxt user gInfo) indexesInGroup
#endif
-getSupportScopeMembersByIndexes :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMemberId -> [Int64] -> IO [GroupMember]
-getSupportScopeMembersByIndexes db vr user gInfo scopeGMId indexesInGroup = do
+getSupportScopeMembersByIndexes :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMemberId -> [Int64] -> IO [GroupMember]
+getSupportScopeMembersByIndexes db cxt user gInfo scopeGMId indexesInGroup = do
#if defined(dbPostgres)
let GroupInfo {groupId} = gInfo
- map (toContactMember vr user) <$>
+ map (toContactMember cxt user) <$>
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group IN ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)")
(groupId, In indexesInGroup, GRModerator, GRAdmin, GROwner, scopeGMId)
#else
- rights <$> mapM (runExceptT . getSupportScopeMemberByIndex db vr user gInfo scopeGMId) indexesInGroup
+ rights <$> mapM (runExceptT . getSupportScopeMemberByIndex db cxt user gInfo scopeGMId) indexesInGroup
#endif
-getGroupModerators :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
-getGroupModerators db vr user@User {userId, userContactId} GroupInfo {groupId} = do
- map (toContactMember vr user)
+getGroupModerators :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
+getGroupModerators db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
+ map (toContactMember cxt user)
<$> DB.query
db
(groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)")
@@ -1212,33 +1212,33 @@ getGroupModerators db vr user@User {userId, userContactId} GroupInfo {groupId} =
-- Moderators and admins only, excluding owners and non-current members.
-- Used for roster-related paths where owners must not be touched (owners are
-- link-anchored), and left/removed members must not appear in the saved roster.
-getGroupRosterMembers :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
-getGroupRosterMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do
- filter memberCurrent . map (toContactMember vr user)
+getGroupRosterMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
+getGroupRosterMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
+ filter memberCurrent . map (toContactMember cxt user)
<$> DB.query
db
(groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?)")
(userId, groupId, userContactId, GRModerator, GRAdmin)
-getGroupOwners :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
-getGroupOwners db vr user@User {userId, userContactId} GroupInfo {groupId} = do
- filter memberCurrent . map (toContactMember vr user)
+getGroupOwners :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
+getGroupOwners db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
+ filter memberCurrent . map (toContactMember cxt user)
<$> DB.query
db
(groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role = ?")
(userId, groupId, userContactId, GROwner)
-getGroupRelayMembers :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
-getGroupRelayMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do
- map (toContactMember vr user)
+getGroupRelayMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
+getGroupRelayMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
+ map (toContactMember cxt user)
<$> DB.query
db
(groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND m.contact_id IS DISTINCT FROM ? AND m.member_role = ?")
(userId, groupId, userContactId, GRRelay)
-getGroupMembersForExpiration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
-getGroupMembersForExpiration db vr user@User {userId, userContactId} GroupInfo {groupId} = do
- map (toContactMember vr user)
+getGroupMembersForExpiration :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
+getGroupMembersForExpiration db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
+ map (toContactMember cxt user)
<$> DB.query
db
( groupMemberQuery
@@ -1253,22 +1253,22 @@ getGroupMembersForExpiration db vr user@User {userId, userContactId} GroupInfo {
)
(groupId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown)
-getRemovedMembersToCleanup :: DB.Connection -> VersionRangeChat -> User -> UTCTime -> IO [GroupMember]
-getRemovedMembersToCleanup db vr user@User {userId} cutoffTs =
- map (toContactMember vr user)
+getRemovedMembersToCleanup :: DB.Connection -> StoreCxt -> User -> UTCTime -> IO [GroupMember]
+getRemovedMembersToCleanup db cxt user@User {userId} cutoffTs =
+ map (toContactMember cxt user)
<$> DB.query
db
(groupMemberQuery <> " WHERE m.user_id = ? AND m.removed_at < ?")
(userId, cutoffTs)
-getGroupInvitation :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
-getGroupInvitation db vr user groupId =
+getGroupInvitation :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
+getGroupInvitation db cxt user groupId =
getConnRec_ user >>= \case
Just connRequest -> do
- groupInfo@GroupInfo {membership} <- getGroupInfo db vr user groupId
+ groupInfo@GroupInfo {membership} <- getGroupInfo db cxt user groupId
when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined
hostId <- getHostMemberId_ db user groupId
- fromMember <- getGroupMember db vr user groupId hostId
+ fromMember <- getGroupMember db cxt user groupId hostId
pure ReceivedGroupInvitation {fromMember, connRequest, groupInfo}
_ -> throwError SEGroupInvitationNotFound
where
@@ -1445,8 +1445,8 @@ setGroupMemberKeyRole db GroupMember {groupMemberId} pubKey role = do
currentTs <- getCurrentTime
DB.execute db "UPDATE group_members SET member_pub_key = ?, member_role = ?, updated_at = ? WHERE group_member_id = ?" (pubKey, role, currentTs, groupMemberId)
-createRelayForOwner :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupInfo -> UserChatRelay -> ExceptT StoreError IO GroupMember
-createRelayForOwner db vr gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do
+createRelayForOwner :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> UserChatRelay -> ExceptT StoreError IO GroupMember
+createRelayForOwner db cxt gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do
currentTs <- liftIO getCurrentTime
let relayProfile = profileFromName displayName
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user relayProfile currentTs
@@ -1465,14 +1465,14 @@ createRelayForOwner db vr gVar user@User {userId, userContactId} GroupInfo {grou
:. (userId, localDisplayName, memProfileId, currentTs, currentTs)
)
liftIO $ insertedRowId db
- getGroupMemberById db vr user groupMemberId
+ getGroupMemberById db cxt user groupMemberId
-getCreateRelayForMember :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupInfo -> ShortLinkContact -> ExceptT StoreError IO GroupMember
-getCreateRelayForMember db vr gVar user@User {userId, userContactId} GroupInfo {groupId, localDisplayName = groupLDN} relayLink =
+getCreateRelayForMember :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> ShortLinkContact -> ExceptT StoreError IO GroupMember
+getCreateRelayForMember db cxt gVar user@User {userId, userContactId} GroupInfo {groupId, localDisplayName = groupLDN} relayLink =
liftIO getGroupMemberByRelayLink >>= maybe createRelayMember pure
where
getGroupMemberByRelayLink =
- maybeFirstRow (toContactMember vr user) $
+ maybeFirstRow (toContactMember cxt user) $
DB.query
db
#if defined(dbPostgres)
@@ -1503,10 +1503,10 @@ getCreateRelayForMember db vr gVar user@User {userId, userContactId} GroupInfo {
:. (userId, localDisplayName, profileId, currentTs, currentTs, relayLink)
)
insertedRowId db
- getGroupMember db vr user groupId groupMemberId
+ getGroupMember db cxt user groupId groupMemberId
-createRelayConnection :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ConnId -> ConnStatus -> VersionChat -> SubscriptionMode -> ExceptT StoreError IO Connection
-createRelayConnection db vr user@User {userId} groupMemberId agentConnId connStatus chatV subMode = do
+createRelayConnection :: DB.Connection -> StoreCxt -> User -> Int64 -> ConnId -> ConnStatus -> VersionChat -> SubscriptionMode -> ExceptT StoreError IO Connection
+createRelayConnection db cxt user@User {userId} groupMemberId agentConnId connStatus chatV subMode = do
currentTs <- liftIO getCurrentTime
liftIO $
DB.execute
@@ -1523,7 +1523,7 @@ createRelayConnection db vr user@User {userId} groupMemberId agentConnId connSta
:. (currentTs, currentTs)
)
connId <- liftIO $ insertedRowId db
- getConnectionById db vr user connId
+ getConnectionById db cxt user connId
updateRelayStatus :: DB.Connection -> GroupRelay -> RelayStatus -> IO GroupRelay
updateRelayStatus db relay@GroupRelay {groupRelayId} relayStatus =
@@ -1540,8 +1540,8 @@ updateRelayStatus_ db relayId relayStatus = do
currentTs <- getCurrentTime
DB.execute db "UPDATE group_relays SET relay_status = ?, updated_at = ? WHERE group_relay_id = ?" (relayStatus, currentTs, relayId)
-setRelayKey :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> MemberKey -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay)
-setRelayKey db vr user m (MemberKey relayKey) profile = do
+setRelayKey :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberKey -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay)
+setRelayKey db cxt user m (MemberKey relayKey) profile = do
let gmId = groupMemberId' m
currentTs <- liftIO getCurrentTime
liftIO $ DB.execute
@@ -1553,7 +1553,7 @@ setRelayKey db vr user m (MemberKey relayKey) profile = do
|]
(relayKey, currentTs, gmId)
void $ updateMemberProfile db user m profile
- (,) <$> getGroupMemberById db vr user gmId <*> getGroupRelayByGMId db gmId
+ (,) <$> getGroupMemberById db cxt user gmId <*> getGroupRelayByGMId db gmId
setRelayLinkConfId :: DB.Connection -> GroupMember -> ConfirmationId -> ShortLinkContact -> IO ()
setRelayLinkConfId db m confId relayLink = do
@@ -1621,8 +1621,8 @@ setGroupInProgressDone db GroupInfo {groupId} = do
"UPDATE groups SET creating_in_progress = 0, updated_at = ? WHERE group_id = ?"
(currentTs, groupId)
-createRelayRequestGroup :: DB.Connection -> VersionRangeChat -> User -> GroupRelayInvitation -> InvitationId -> VersionRangeChat -> Int64 -> GroupMemberStatus -> RelayStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
-createRelayRequestGroup db vr user@User {userId} GroupRelayInvitation {fromMember, fromMemberProfile, relayMemberId, groupLink} invId reqChatVRange initialDelay memberStatus relayStatus = do
+createRelayRequestGroup :: DB.Connection -> StoreCxt -> User -> GroupRelayInvitation -> InvitationId -> VersionRangeChat -> Int64 -> GroupMemberStatus -> RelayStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
+createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMember, fromMemberProfile, relayMemberId, groupLink} invId reqChatVRange initialDelay memberStatus relayStatus = do
currentTs <- liftIO getCurrentTime
-- Create group with placeholder profile
let Profile {displayName = fromMemberLDN} = fromMemberProfile
@@ -1642,9 +1642,9 @@ createRelayRequestGroup db vr user@User {userId} GroupRelayInvitation {fromMembe
ownerMemberId <- insertOwner_ currentTs groupId
let relayMember = MemberIdRole relayMemberId GRRelay
-- TODO [member keys] should relays use member keys?
- _membership <- createContactMemberInv_ db user groupId (Just ownerMemberId) user relayMember GCUserMember memberStatus IBUnknown Nothing Nothing currentTs vr
- ownerMember <- getGroupMember db vr user groupId ownerMemberId
- g <- getGroupInfo db vr user groupId
+ _membership <- createContactMemberInv_ db user groupId (Just ownerMemberId) user relayMember GCUserMember memberStatus IBUnknown Nothing Nothing currentTs (vr cxt)
+ ownerMember <- getGroupMember db cxt user groupId ownerMemberId
+ g <- getGroupInfo db cxt user groupId
pure (g, ownerMember)
where
setRelayRequestData_ groupId currentTs =
@@ -1696,8 +1696,8 @@ updateRelayOwnStatus_ db GroupInfo {groupId} relayStatus = do
-- Flip every RSRejected row sharing the targeted group's relay_request_group_link
-- to RSInactive in one statement; returns the refreshed GroupInfo for the targeted groupId.
-allowRelayGroup :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO GroupInfo
-allowRelayGroup db vr user@User {userId} groupId = do
+allowRelayGroup :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO GroupInfo
+allowRelayGroup db cxt user@User {userId} groupId = do
currentTs <- liftIO getCurrentTime
liftIO $
DB.execute
@@ -1710,7 +1710,7 @@ allowRelayGroup db vr user@User {userId} groupId = do
AND relay_own_status = ?
|]
(RSInactive, currentTs, currentTs, userId, groupId, RSRejected)
- getGroupInfo db vr user groupId
+ getGroupInfo db cxt user groupId
isRelayGroupRejected :: DB.Connection -> User -> ShortLinkContact -> IO Bool
isRelayGroupRejected db User {userId} groupLink =
@@ -1729,9 +1729,9 @@ isRelayGroupRejected db User {userId} groupLink =
(userId, groupLink, RSRejected)
)
-getRelayServedGroups :: DB.Connection -> VersionRangeChat -> User -> IO [GroupInfo]
-getRelayServedGroups db vr User {userId, userContactId} = do
- map (toGroupInfo vr userContactId [])
+getRelayServedGroups :: DB.Connection -> StoreCxt -> User -> IO [GroupInfo]
+getRelayServedGroups db cxt User {userId, userContactId} = do
+ map (toGroupInfo cxt userContactId [])
<$> DB.query
db
( groupInfoQuery
@@ -1739,10 +1739,10 @@ getRelayServedGroups db vr User {userId, userContactId} = do
)
(userId, userContactId, RSAccepted, RSActive)
-getRelayInactiveGroups :: DB.Connection -> VersionRangeChat -> User -> NominalDiffTime -> IO [GroupInfo]
-getRelayInactiveGroups db vr User {userId, userContactId} ttl = do
+getRelayInactiveGroups :: DB.Connection -> StoreCxt -> User -> NominalDiffTime -> IO [GroupInfo]
+getRelayInactiveGroups db cxt User {userId, userContactId} ttl = do
cutoffTs <- addUTCTime (- ttl) <$> getCurrentTime
- map (toGroupInfo vr userContactId [])
+ map (toGroupInfo cxt userContactId [])
<$> DB.query
db
( groupInfoQuery
@@ -1854,10 +1854,10 @@ createJoiningMemberConnection
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV cReqChatVRange Nothing (Just uclId) Nothing 0 createdAt subMode PQSupportOff
setCommandConnId db user cmdId connId
-createBusinessRequestGroup :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> VersionRangeChat -> Profile -> Int64 -> Text -> GroupPreferences -> ExceptT StoreError IO (GroupInfo, GroupMember)
+createBusinessRequestGroup :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> VersionRangeChat -> Profile -> Int64 -> Text -> GroupPreferences -> ExceptT StoreError IO (GroupInfo, GroupMember)
createBusinessRequestGroup
db
- vr
+ cxt
gVar
user@User {userId, userContactId}
cReqChatVRange
@@ -1869,8 +1869,8 @@ createBusinessRequestGroup
(groupId, membership@GroupMember {memberId = userMemberId}) <- insertGroup_ currentTs
(groupMemberId, memberId) <- insertClientMember_ currentTs groupId membership
liftIO $ DB.execute db "UPDATE groups SET business_member_id = ?, customer_member_id = ? WHERE group_id = ?" (userMemberId, memberId, groupId)
- groupInfo <- getGroupInfo db vr user groupId
- clientMember <- getGroupMemberById db vr user groupMemberId
+ groupInfo <- getGroupInfo db cxt user groupId
+ clientMember <- getGroupMemberById db cxt user groupMemberId
pure (groupInfo, clientMember)
where
insertGroup_ currentTs = do
@@ -1893,7 +1893,7 @@ createBusinessRequestGroup
groupId <- liftIO $ insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12
-- TODO [member keys] we could support member keys in business groups to allow binding agreements (though identity keys would be better for it.
- membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing Nothing currentTs vr
+ membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing Nothing currentTs (vr cxt)
pure (groupId, membership)
VersionRange minV maxV = cReqChatVRange
insertClientMember_ currentTs groupId membership =
@@ -1917,8 +1917,8 @@ createBusinessRequestGroup
groupMemberId <- liftIO $ insertedRowId db
pure (groupMemberId, MemberId memId)
-getContactViaMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> ExceptT StoreError IO Contact
-getContactViaMember db vr user@User {userId} GroupMember {groupMemberId} = do
+getContactViaMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> ExceptT StoreError IO Contact
+getContactViaMember db cxt user@User {userId} GroupMember {groupMemberId} = do
contactId <-
ExceptT $
firstRow fromOnly (SEContactNotFoundByMemberId groupMemberId) $
@@ -1932,7 +1932,7 @@ getContactViaMember db vr user@User {userId} GroupMember {groupMemberId} = do
LIMIT 1
|]
(userId, groupMemberId)
- getContact db vr user contactId
+ getContact db cxt user contactId
setNewContactMemberConnRequest :: DB.Connection -> User -> GroupMember -> ConnReqInvitation -> IO ()
setNewContactMemberConnRequest db User {userId} GroupMember {groupMemberId} connRequest = do
@@ -1959,18 +1959,18 @@ createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentCon
-- This is called once before connecting to relays, unlike createConnReqConnection -> setPreparedGroupLinkInfo_,
-- which is used in single-connection flows.
updatePreparedRelayedGroup ::
- DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Profile ->
+ DB.Connection -> StoreCxt -> User -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Profile ->
C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> Maybe Int64 ->
ExceptT StoreError IO GroupInfo
-updatePreparedRelayedGroup db vr user@User {userId} gInfo cReq cReqHash incognitoProfile rootPubKey memberPrivKey publicMemberCount_ = do
+updatePreparedRelayedGroup db cxt user@User {userId} gInfo cReq cReqHash incognitoProfile rootPubKey memberPrivKey publicMemberCount_ = do
currentTs <- liftIO getCurrentTime
customUserProfileId <- liftIO $ mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile
liftIO $ setPreparedGroupLinkInfo_ db gInfo cReq cReqHash customUserProfileId publicMemberCount_ currentTs
liftIO $ updateGroupMemberKeys db (groupId' gInfo) rootPubKey memberPrivKey (groupMemberId' $ membership gInfo)
- getGroupInfo db vr user (groupId' gInfo)
+ getGroupInfo db cxt user (groupId' gInfo)
-updatePublicMemberCount :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ExceptT StoreError IO GroupInfo
-updatePublicMemberCount db vr user GroupInfo {groupId} = do
+updatePublicMemberCount :: DB.Connection -> StoreCxt -> User -> GroupInfo -> ExceptT StoreError IO GroupInfo
+updatePublicMemberCount db cxt user GroupInfo {groupId} = do
liftIO $ do
totalCount <- fromMaybe 0 <$> maybeFirstRow fromOnly
(DB.query db "SELECT summary_current_members_count FROM groups WHERE group_id = ?" (Only groupId))
@@ -1986,13 +1986,13 @@ updatePublicMemberCount db vr user GroupInfo {groupId} = do
let publicCount = max 0 (totalCount - relayCount) :: Int64
currentTs <- getCurrentTime
DB.execute db "UPDATE groups SET public_member_count = ?, updated_at = ? WHERE group_id = ?" (publicCount, currentTs, groupId)
- getGroupInfo db vr user groupId
+ getGroupInfo db cxt user groupId
-setPublicMemberCount :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Int64 -> ExceptT StoreError IO GroupInfo
-setPublicMemberCount db vr user GroupInfo {groupId} publicCount = do
+setPublicMemberCount :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Int64 -> ExceptT StoreError IO GroupInfo
+setPublicMemberCount db cxt user GroupInfo {groupId} publicCount = do
currentTs <- liftIO getCurrentTime
liftIO $ DB.execute db "UPDATE groups SET public_member_count = ?, updated_at = ? WHERE group_id = ?" (publicCount, currentTs, groupId)
- getGroupInfo db vr user groupId
+ getGroupInfo db cxt user groupId
updateGroupMemberKeys :: DB.Connection -> GroupId -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> GroupMemberId -> IO ()
updateGroupMemberKeys db groupId rootPubKey memberPrivKey membershipGMId = do
@@ -2494,8 +2494,8 @@ updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName
let publicGroupAccess = toPublicGroupAccess accessRow
in GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ publicGroupAccess, groupPreferences, memberAdmission}
-getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
-getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
+getGroupInfoByUserContactLinkConnReq :: DB.Connection -> StoreCxt -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
+getGroupInfoByUserContactLinkConnReq db cxt user@User {userId} (cReqSchema1, cReqSchema2) = do
-- fmap join is to support group_id = NULL if non-group contact request is sent to this function (e.g., if client data is appended).
groupId_ <-
fmap join . maybeFirstRow fromOnly $
@@ -2507,12 +2507,12 @@ getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReq
WHERE user_id = ? AND conn_req_contact IN (?,?)
|]
(userId, cReqSchema1, cReqSchema2)
- maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_
+ maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db cxt user) groupId_
-getGroupInfoViaUserShortLink :: DB.Connection -> VersionRangeChat -> User -> ShortLinkContact -> IO (Maybe (ConnReqContact, GroupInfo))
-getGroupInfoViaUserShortLink db vr user@User {userId} shortLink = fmap eitherToMaybe $ runExceptT $ do
+getGroupInfoViaUserShortLink :: DB.Connection -> StoreCxt -> User -> ShortLinkContact -> IO (Maybe (ConnReqContact, GroupInfo))
+getGroupInfoViaUserShortLink db cxt user@User {userId} shortLink = fmap eitherToMaybe $ runExceptT $ do
(cReq, groupId) <- ExceptT getConnReqGroup
- (cReq,) <$> getGroupInfo db vr user groupId
+ (cReq,) <$> getGroupInfo db cxt user groupId
where
getConnReqGroup =
firstRow' toConnReqGroupId (SEInternalError "group link not found") $
@@ -2529,14 +2529,14 @@ getGroupInfoViaUserShortLink db vr user@User {userId} shortLink = fmap eitherToM
(cReq, Just groupId) -> Right (cReq, groupId)
_ -> Left $ SEInternalError "no conn req or group ID"
-getGroupViaShortLinkToConnect :: DB.Connection -> VersionRangeChat -> User -> ShortLinkContact -> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
-getGroupViaShortLinkToConnect db vr user@User {userId} shortLink =
+getGroupViaShortLinkToConnect :: DB.Connection -> StoreCxt -> User -> ShortLinkContact -> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
+getGroupViaShortLinkToConnect db cxt user@User {userId} shortLink =
liftIO (maybeFirstRow id $ DB.query db "SELECT group_id, conn_full_link_to_connect FROM groups WHERE user_id = ? AND conn_short_link_to_connect = ?" (userId, shortLink)) >>= \case
- Just (gId :: Int64, Just cReq) -> Just . (cReq,) <$> getGroupInfo db vr user gId
+ Just (gId :: Int64, Just cReq) -> Just . (cReq,) <$> getGroupInfo db cxt user gId
_ -> pure Nothing
-getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
-getGroupInfoByGroupLinkHash db vr user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do
+getGroupInfoByGroupLinkHash :: DB.Connection -> StoreCxt -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
+getGroupInfoByGroupLinkHash db cxt user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do
groupId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -2550,7 +2550,7 @@ getGroupInfoByGroupLinkHash db vr user@User {userId, userContactId} (groupLinkHa
LIMIT 1
|]
(userId, groupLinkHash1, groupLinkHash2, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown)
- maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_
+ maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db cxt user) groupId_
getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId
getGroupIdByName db User {userId} gName =
@@ -2562,8 +2562,8 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName =
ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $
DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName)
-getActiveMembersByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
-getActiveMembersByName db vr user@User {userId} groupMemberName = do
+getActiveMembersByName :: DB.Connection -> StoreCxt -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
+getActiveMembersByName db cxt user@User {userId} groupMemberName = do
groupMemberIds :: [(GroupId, GroupMemberId)] <-
liftIO $
DB.query
@@ -2576,17 +2576,17 @@ getActiveMembersByName db vr user@User {userId} groupMemberName = do
|]
(userId, groupMemberName, GSMemConnected, GSMemComplete, GCUserMember)
possibleMembers <- forM groupMemberIds $ \(groupId, groupMemberId) -> do
- groupInfo <- getGroupInfo db vr user groupId
- groupMember <- getGroupMember db vr user groupId groupMemberId
+ groupInfo <- getGroupInfo db cxt user groupId
+ groupMember <- getGroupMember db cxt user groupId groupMemberId
pure (groupInfo, groupMember)
pure $ sortOn (Down . ts . fst) possibleMembers
where
ts GroupInfo {chatTs, updatedAt} = fromMaybe updatedAt chatTs
-getMatchingContacts :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO [Contact]
-getMatchingContacts db vr user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, shortDescr, image}} = do
+getMatchingContacts :: DB.Connection -> StoreCxt -> User -> Contact -> IO [Contact]
+getMatchingContacts db cxt user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, shortDescr, image}} = do
contactIds <- map fromOnly <$> DB.query db q (userId, contactId, CSActive, displayName, fullName, shortDescr, image)
- rights <$> mapM (runExceptT . getContact db vr user) contactIds
+ rights <$> mapM (runExceptT . getContact db cxt user) contactIds
where
-- this query is different from one in getMatchingMemberContacts
-- it checks that it's not the same contact
@@ -2601,10 +2601,10 @@ getMatchingContacts db vr user@User {userId} Contact {contactId, profile = Local
AND p.short_descr IS NOT DISTINCT FROM ? AND p.image IS NOT DISTINCT FROM ?
|]
-getMatchingMembers :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO [GroupMember]
-getMatchingMembers db vr user@User {userId} Contact {profile = LocalProfile {displayName, fullName, shortDescr, image}} = do
+getMatchingMembers :: DB.Connection -> StoreCxt -> User -> Contact -> IO [GroupMember]
+getMatchingMembers db cxt user@User {userId} Contact {profile = LocalProfile {displayName, fullName, shortDescr, image}} = do
memberIds <- map fromOnly <$> DB.query db q (userId, GCUserMember, displayName, fullName, shortDescr, image)
- filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
+ filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db cxt user) memberIds
where
-- only match with members without associated contact
q =
@@ -2618,11 +2618,11 @@ getMatchingMembers db vr user@User {userId} Contact {profile = LocalProfile {dis
AND p.short_descr IS NOT DISTINCT FROM ? AND p.image IS NOT DISTINCT FROM ?
|]
-getMatchingMemberContacts :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> IO [Contact]
+getMatchingMemberContacts :: DB.Connection -> StoreCxt -> User -> GroupMember -> IO [Contact]
getMatchingMemberContacts _ _ _ GroupMember {memberContactId = Just _} = pure []
-getMatchingMemberContacts db vr user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, shortDescr, image}} = do
+getMatchingMemberContacts db cxt user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, shortDescr, image}} = do
contactIds <- map fromOnly <$> DB.query db q (userId, CSActive, displayName, fullName, shortDescr, image)
- rights <$> mapM (runExceptT . getContact db vr user) contactIds
+ rights <$> mapM (runExceptT . getContact db cxt user) contactIds
where
q =
[sql|
@@ -2655,8 +2655,8 @@ createSentProbeHash db userId probeId to = do
"INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, group_member_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(probeId, ctId, gmId, userId, currentTs, currentTs)
-matchReceivedProbe :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
-matchReceivedProbe db vr user@User {userId} from (Probe probe) = do
+matchReceivedProbe :: DB.Connection -> StoreCxt -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
+matchReceivedProbe db cxt user@User {userId} from (Probe probe) = do
let probeHash = C.sha256Hash probe
cgmIds <-
DB.query
@@ -2677,7 +2677,7 @@ matchReceivedProbe db vr user@User {userId} from (Probe probe) = do
"INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(ctId, gmId, Binary probe, Binary probeHash, userId, currentTs, currentTs)
let cgmIds' = filterFirstContactId cgmIds
- catMaybes <$> mapM (getContactOrMember_ db vr user) cgmIds'
+ catMaybes <$> mapM (getContactOrMember_ db cxt user) cgmIds'
where
filterFirstContactId :: [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] -> [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)]
filterFirstContactId cgmIds = do
@@ -2687,8 +2687,8 @@ matchReceivedProbe db vr user@User {userId} from (Probe probe) = do
(x : _) -> [x]
ctIds' <> memIds
-matchReceivedProbeHash :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
-matchReceivedProbeHash db vr user@User {userId} from (ProbeHash probeHash) = do
+matchReceivedProbeHash :: DB.Connection -> StoreCxt -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
+matchReceivedProbeHash db cxt user@User {userId} from (ProbeHash probeHash) = do
probeIds <-
maybeFirstRow id $
DB.query
@@ -2708,11 +2708,11 @@ matchReceivedProbeHash db vr user@User {userId} from (ProbeHash probeHash) = do
db
"INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(ctId, gmId, Binary probeHash, userId, currentTs, currentTs)
- pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db vr user cgmIds
+ pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db cxt user cgmIds
-matchSentProbe :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
-matchSentProbe db vr user@User {userId} _from (Probe probe) = do
- cgmIds $>>= getContactOrMember_ db vr user
+matchSentProbe :: DB.Connection -> StoreCxt -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
+matchSentProbe db cxt user@User {userId} _from (Probe probe) = do
+ cgmIds $>>= getContactOrMember_ db cxt user
where
(ctId, gmId) = contactOrMemberIds _from
cgmIds =
@@ -2731,11 +2731,11 @@ matchSentProbe db vr user@User {userId} _from (Probe probe) = do
|]
(userId, Binary probe, ctId, gmId)
-getContactOrMember_ :: DB.Connection -> VersionRangeChat -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
-getContactOrMember_ db vr user ids =
+getContactOrMember_ :: DB.Connection -> StoreCxt -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
+getContactOrMember_ db cxt user ids =
fmap eitherToMaybe . runExceptT $ case ids of
- (Just ctId, _, _) -> COMContact <$> getContact db vr user ctId
- (_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db vr user gId gmId
+ (Just ctId, _, _) -> COMContact <$> getContact db cxt user ctId
+ (_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db cxt user gId gmId
_ -> throwError $ SEInternalError ""
associateMemberWithContactRecord :: DB.Connection -> User -> Contact -> GroupMember -> IO ()
@@ -2756,10 +2756,10 @@ associateMemberWithContactRecord
when (memProfileId /= profileId) $ deleteUnusedProfile_ db userId memProfileId
when (memLDN /= localDisplayName) $ deleteUnusedDisplayName_ db userId memLDN
-associateContactWithMemberRecord :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
+associateContactWithMemberRecord :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
associateContactWithMemberRecord
db
- vr
+ cxt
user@User {userId}
GroupMember {groupId, groupMemberId, localDisplayName = memLDN, memberProfile = LocalProfile {profileId = memProfileId}}
Contact {contactId, localDisplayName, profile = LocalProfile {profileId}} = do
@@ -2783,7 +2783,7 @@ associateContactWithMemberRecord
(memLDN, memProfileId, currentTs, userId, contactId)
when (profileId /= memProfileId) $ deleteUnusedProfile_ db userId profileId
when (localDisplayName /= memLDN) $ deleteUnusedDisplayName_ db userId localDisplayName
- getContact db vr user contactId
+ getContact db cxt user contactId
deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO ()
deleteUnusedDisplayName_ db userId localDisplayName =
@@ -2939,15 +2939,15 @@ createMemberContact
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, preparedContact = Nothing, contactRequestId = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, groupDirectInv = Nothing, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
-getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
-getMemberContact db vr user contactId = do
- ct <- getContact db vr user contactId
+getMemberContact :: DB.Connection -> StoreCxt -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
+getMemberContact db cxt user contactId = do
+ ct <- getContact db cxt user contactId
let Contact {contactGroupMemberId, activeConn} = ct
case (activeConn, contactGroupMemberId) of
(Just Connection {connId}, Just groupMemberId) -> do
cReq <- getConnReqInv db connId
- m@GroupMember {groupId} <- getGroupMemberById db vr user groupMemberId
- g <- getGroupInfo db vr user groupId
+ m@GroupMember {groupId} <- getGroupMemberById db cxt user groupMemberId
+ g <- getGroupInfo db cxt user groupId
pure (g, m, ct, cReq)
_ ->
throwError $ SEMemberContactGroupMemberNotFound contactId
@@ -3056,13 +3056,13 @@ createMemberContactConn
forM_ cmdId_ $ \cmdId -> setCommandConnId db user cmdId connId
pure connId
-getMemberContactInvited :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, Connection, Contact, GroupDirectInvitation)
-getMemberContactInvited db vr user contactId = do
- ct@Contact {groupDirectInv = groupDirectInv_} <- getContact db vr user contactId
+getMemberContactInvited :: DB.Connection -> StoreCxt -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, Connection, Contact, GroupDirectInvitation)
+getMemberContactInvited db cxt user contactId = do
+ ct@Contact {groupDirectInv = groupDirectInv_} <- getContact db cxt user contactId
case groupDirectInv_ of
Just groupDirectInv@GroupDirectInvitation {fromGroupId_ = Just groupId, fromGroupMemberId_ = Just _gmId, fromGroupMemberConnId_ = Just mConnId} -> do
- g <- getGroupInfo db vr user groupId
- mConn <- getConnectionById db vr user mConnId
+ g <- getGroupInfo db cxt user groupId
+ mConn <- getConnectionById db cxt user mConnId
pure (g, mConn, ct, groupDirectInv)
_ ->
throwError $ SEMemberContactGroupMemberNotFound contactId
@@ -3124,8 +3124,8 @@ setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do
"UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
(BI xGrpLinkMemReceived, currentTs, mId)
-createNewUnknownGroupMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> Text -> GroupMemberRole -> ExceptT StoreError IO GroupMember
-createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {groupId} memberId memberName unknownMemberRole = do
+createNewUnknownGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberId -> Text -> GroupMemberRole -> ExceptT StoreError IO GroupMember
+createNewUnknownGroupMember db cxt user@User {userId, userContactId} GroupInfo {groupId} memberId memberName unknownMemberRole = do
currentTs <- liftIO getCurrentTime
let memberProfile = profileFromName memberName
(localDisplayName, profileId) <- createNewMemberProfile_ db user memberProfile currentTs
@@ -3145,12 +3145,12 @@ createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {g
:. (minV, maxV)
)
groupMemberId <- liftIO $ insertedRowId db
- getGroupMemberById db vr user groupMemberId
+ getGroupMemberById db cxt user groupMemberId
where
- VersionRange minV maxV = vr
+ VersionRange minV maxV = vr cxt
-createLinkOwnerMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe ContactId -> MemberId -> C.PublicKeyEd25519 -> ExceptT StoreError IO GroupMember
-createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId} contactId_ memberId ownerKey = do
+createLinkOwnerMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe ContactId -> MemberId -> C.PublicKeyEd25519 -> ExceptT StoreError IO GroupMember
+createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupId} contactId_ memberId ownerKey = do
currentTs <- liftIO getCurrentTime
let memberProfile = profileFromName $ nameFromMemberId memberId
(localDisplayName, profileId) <- createNewMemberProfile_ db user memberProfile currentTs
@@ -3170,15 +3170,15 @@ createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId
:. (minV, maxV)
)
groupMemberId <- liftIO $ insertedRowId db
- getGroupMemberById db vr user groupMemberId
+ getGroupMemberById db cxt user groupMemberId
where
- VersionRange minV maxV = vr
+ VersionRange minV maxV = vr cxt
-- member_pub_key is not updated here — introduced members are owners
-- whose keys are loaded from link data (trusted out-of-band).
-- Updating from an in-band message would allow a compromised relay to substitute keys.
-updatePreparedChannelMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
-updatePreparedChannelMember db vr user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do
+updatePreparedChannelMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
+updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do
_ <- updateMemberProfile db user member profile
currentTs <- liftIO getCurrentTime
liftIO $
@@ -3194,12 +3194,12 @@ updatePreparedChannelMember db vr user@User {userId} member@GroupMember {groupMe
WHERE user_id = ? AND group_member_id = ?
|]
(memberRole, GSMemIntroduced, minV, maxV, currentTs, userId, groupMemberId)
- getGroupMemberById db vr user groupMemberId
+ getGroupMemberById db cxt user groupMemberId
where
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
-updateUnknownMemberAnnounced :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
-updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} status = do
+updateUnknownMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
+updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} status = do
_ <- updateMemberProfile db user unknownMember profile
currentTs <- liftIO getCurrentTime
liftIO $
@@ -3220,15 +3220,15 @@ updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMemb
( (memberRole, GCPostMember, status, groupMemberId' invitingMember)
:. (minV, maxV, memberPubKey_, currentTs, userId, groupMemberId)
)
- getGroupMemberById db vr user groupMemberId
+ getGroupMemberById db cxt user groupMemberId
where
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey
-- Like updateUnknownMemberAnnounced but preserves member_role and member_pub_key
-- (roster-established for moderators/admins; the dissemination carries only the profile).
-updateRosterMemberAnnounced :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
-updateRosterMemberAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} status = do
+updateRosterMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
+updateRosterMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} status = do
_ <- updateMemberProfile db user unknownMember profile
currentTs <- liftIO getCurrentTime
liftIO $
@@ -3245,7 +3245,7 @@ updateRosterMemberAnnounced db vr user@User {userId} invitingMember unknownMembe
WHERE user_id = ? AND group_member_id = ?
|]
((GCPostMember, status, groupMemberId' invitingMember) :. (minV, maxV, currentTs, userId, groupMemberId))
- getGroupMemberById db vr user groupMemberId
+ getGroupMemberById db cxt user groupMemberId
where
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs
index 5f6a5b2241..410b2ec6da 100644
--- a/src/Simplex/Chat/Store/Messages.hs
+++ b/src/Simplex/Chat/Store/Messages.hs
@@ -403,8 +403,8 @@ data MemberAttention
| MAReset
deriving (Show)
-updateChatTsStats :: DB.Connection -> VersionRangeChat -> User -> ChatDirection c d -> UTCTime -> Maybe (Int, MemberAttention, Int) -> IO (ChatInfo c)
-updateChatTsStats db vr user@User {userId} chatDirection chatTs chatStats_ = case toChatInfo chatDirection of
+updateChatTsStats :: DB.Connection -> StoreCxt -> User -> ChatDirection c d -> UTCTime -> Maybe (Int, MemberAttention, Int) -> IO (ChatInfo c)
+updateChatTsStats db cxt user@User {userId} chatDirection chatTs chatStats_ = case toChatInfo chatDirection of
DirectChat ct@Contact {contactId} -> do
DB.execute
db
@@ -513,7 +513,7 @@ updateChatTsStats db vr user@User {userId} chatDirection chatTs chatStats_ = cas
WHERE group_member_id = ?
|]
(chatTs, unread, mentions, groupMemberId)
- m_ <- runExceptT $ getGroupMemberById db vr user groupMemberId
+ m_ <- runExceptT $ getGroupMemberById db cxt user groupMemberId
pure $ either (const m) id m_ -- Left shouldn't happen, but types require it
LocalChat nf@NoteFolder {noteFolderId} -> do
DB.execute
@@ -527,8 +527,8 @@ setSupportChatTs :: DB.Connection -> GroupMemberId -> UTCTime -> IO ()
setSupportChatTs db groupMemberId chatTs =
DB.execute db "UPDATE group_members SET support_chat_ts = ? WHERE group_member_id = ?" (chatTs, groupMemberId)
-setSupportChatMemberAttention :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> Int64 -> IO (GroupInfo, GroupMember)
-setSupportChatMemberAttention db vr user g m memberAttention = do
+setSupportChatMemberAttention :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> Int64 -> IO (GroupInfo, GroupMember)
+setSupportChatMemberAttention db cxt user g m memberAttention = do
m' <- updateGMAttention
g' <- updateGroupMembersRequireAttention db user g m m'
pure (g', m')
@@ -539,7 +539,7 @@ setSupportChatMemberAttention db vr user g m memberAttention = do
db
"UPDATE group_members SET support_chat_items_member_attention = ?, updated_at = ? WHERE group_member_id = ?"
(memberAttention, currentTs, groupMemberId' m)
- m_ <- runExceptT $ getGroupMemberById db vr user (groupMemberId' m)
+ m_ <- runExceptT $ getGroupMemberById db cxt user (groupMemberId' m)
pure $ either (const m) id m_ -- Left shouldn't happen, but types require it
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> ShowGroupAsSender -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> UTCTime -> IO ChatItemId
@@ -730,8 +730,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow
-getChatPreviews :: DB.Connection -> VersionRangeChat -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
-getChatPreviews db vr user withPCC pagination query = do
+getChatPreviews :: DB.Connection -> StoreCxt -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
+getChatPreviews db cxt user withPCC pagination query = do
directChats <- findDirectChatPreviews_ db user pagination query
groupChats <- findGroupChatPreviews_ db user pagination query
localChats <- findLocalChatPreviews_ db user pagination query
@@ -753,8 +753,8 @@ getChatPreviews db vr user withPCC pagination query = do
PTBefore _ count -> take count . sortBy (comparing $ Down . ts)
getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat
getChatPreview (ACPD cType cpd) = case cType of
- SCTDirect -> getDirectChatPreview_ db vr user cpd
- SCTGroup -> getGroupChatPreview_ db vr user cpd
+ SCTDirect -> getDirectChatPreview_ db cxt user cpd
+ SCTGroup -> getGroupChatPreview_ db cxt user cpd
SCTLocal -> getLocalChatPreview_ db user cpd
SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat
SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat
@@ -871,9 +871,9 @@ findDirectChatPreviews_ db User {userId} pagination clq =
PTAfter ts count -> DB.query db (query <> " AND ct.chat_ts > ? ORDER BY ct.chat_ts ASC LIMIT ?") (params :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND ct.chat_ts < ? ORDER BY ct.chat_ts DESC LIMIT ?") (params :. (ts, count))
-getDirectChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
-getDirectChatPreview_ db vr user (DirectChatPD _ contactId lastItemId_ stats) = do
- contact <- getContact db vr user contactId
+getDirectChatPreview_ :: DB.Connection -> StoreCxt -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
+getDirectChatPreview_ db cxt user (DirectChatPD _ contactId lastItemId_ stats) = do
+ contact <- getContact db cxt user contactId
ts <- liftIO getCurrentTime
lastItem <- case lastItemId_ of
Just lastItemId -> do
@@ -982,9 +982,9 @@ findGroupChatPreviews_ db User {userId} pagination clq =
PTAfter ts count -> DB.query db (query <> " AND g.chat_ts > ? ORDER BY g.chat_ts ASC LIMIT ?") (params :. (ts, count))
PTBefore ts count -> DB.query db (query <> " AND g.chat_ts < ? ORDER BY g.chat_ts DESC LIMIT ?") (params :. (ts, count))
-getGroupChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
-getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do
- groupInfo <- getGroupInfo db vr user groupId
+getGroupChatPreview_ :: DB.Connection -> StoreCxt -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
+getGroupChatPreview_ db cxt user (GroupChatPD _ groupId lastItemId_ stats) = do
+ groupInfo <- getGroupInfo db cxt user groupId
ts <- liftIO getCurrentTime
lastItem <- case lastItemId_ of
Just lastItemId -> do
@@ -1220,10 +1220,10 @@ getChatContentTypes db User {userId} (ChatRef cType chatId chatScope_) = case cT
("SELECT DISTINCT msg_content_tag FROM chat_items WHERE user_id = ? AND " <> cond <> " AND msg_content_tag IS NOT NULL ORDER BY msg_content_tag")
((userId, chatId) :. params)
-getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
-getDirectChat db vr user contactId contentFilter pagination search_ = do
+getDirectChat :: DB.Connection -> StoreCxt -> User -> Int64 -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
+getDirectChat db cxt user contactId contentFilter pagination search_ = do
let search = fromMaybe "" search_
- ct <- getContact db vr user contactId
+ ct <- getContact db cxt user contactId
case pagination of
CPLast count -> (,Nothing) <$> getDirectChatLast_ db user ct contentFilter count search
CPAfter afterId count -> (,Nothing) <$> getDirectChatAfter_ db user ct contentFilter afterId count search
@@ -1440,11 +1440,11 @@ getContactNavInfo_ db User {userId} Contact {contactId} afterCI = do
:. (userId, contactId, ciCreatedAt afterCI, cChatItemId afterCI)
)
-getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Maybe GroupChatScope -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
-getGroupChat db vr user groupId scope_ contentFilter pagination search_ = do
+getGroupChat :: DB.Connection -> StoreCxt -> User -> Int64 -> Maybe GroupChatScope -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
+getGroupChat db cxt user groupId scope_ contentFilter pagination search_ = do
let search = fromMaybe "" search_
- g <- getGroupInfo db vr user groupId
- scopeInfo <- mapM (getCreateGroupChatScopeInfo db vr user g) scope_
+ g <- getGroupInfo db cxt user groupId
+ scopeInfo <- mapM (getCreateGroupChatScopeInfo db cxt user g) scope_
case pagination of
CPLast count -> (,Nothing) <$> getGroupChatLast_ db user g scopeInfo contentFilter count search emptyChatStats
CPAfter afterId count -> (,Nothing) <$> getGroupChatAfter_ db user g scopeInfo contentFilter afterId count search
@@ -1454,31 +1454,31 @@ getGroupChat db vr user groupId scope_ contentFilter pagination search_ = do
unless (T.null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
getGroupChatInitial_ db user g scopeInfo contentFilter count
-getCreateGroupChatScopeInfo :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
-getCreateGroupChatScopeInfo db vr user GroupInfo {membership} = \case
+getCreateGroupChatScopeInfo :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
+getCreateGroupChatScopeInfo db cxt user GroupInfo {membership} = \case
GCSMemberSupport Nothing -> do
when (isNothing $ supportChat membership) $ do
ts <- liftIO getCurrentTime
liftIO $ setSupportChatTs db (groupMemberId' membership) ts
pure $ GCSIMemberSupport {groupMember_ = Nothing}
GCSMemberSupport (Just gmId) -> do
- m <- getGroupMemberById db vr user gmId
+ m <- getGroupMemberById db cxt user gmId
when (isNothing $ supportChat m) $ do
ts <- liftIO getCurrentTime
liftIO $ setSupportChatTs db gmId ts
pure GCSIMemberSupport {groupMember_ = Just m}
-getGroupChatScopeInfoForItem :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
-getGroupChatScopeInfoForItem db vr user g itemId =
- getGroupChatScopeForItem_ db itemId >>= mapM (getGroupChatScopeInfo db vr user g)
+getGroupChatScopeInfoForItem :: DB.Connection -> StoreCxt -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
+getGroupChatScopeInfoForItem db cxt user g itemId =
+ getGroupChatScopeForItem_ db itemId >>= mapM (getGroupChatScopeInfo db cxt user g)
-getGroupChatScopeInfo :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
-getGroupChatScopeInfo db vr user GroupInfo {membership} = \case
+getGroupChatScopeInfo :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
+getGroupChatScopeInfo db cxt user GroupInfo {membership} = \case
GCSMemberSupport Nothing -> case supportChat membership of
Nothing -> throwError $ SEInternalError "no moderators support chat"
Just _supportChat -> pure $ GCSIMemberSupport {groupMember_ = Nothing}
GCSMemberSupport (Just gmId) -> do
- m <- getGroupMemberById db vr user gmId
+ m <- getGroupMemberById db cxt user gmId
case supportChat m of
Nothing -> throwError $ SEInternalError "no support chat"
Just _supportChat -> pure GCSIMemberSupport {groupMember_ = Just m}
@@ -2084,8 +2084,8 @@ updateGroupChatItemsRead db User {userId} GroupInfo {groupId} = do
|]
(CISRcvRead, currentTs, userId, groupId, CISRcvNew)
-updateSupportChatItemsRead :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScopeInfo -> IO (GroupInfo, GroupMember)
-updateSupportChatItemsRead db vr user@User {userId} g@GroupInfo {groupId, membership} scopeInfo = do
+updateSupportChatItemsRead :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupChatScopeInfo -> IO (GroupInfo, GroupMember)
+updateSupportChatItemsRead db cxt user@User {userId} g@GroupInfo {groupId, membership} scopeInfo = do
currentTs <- getCurrentTime
case scopeInfo of
GCSIMemberSupport {groupMember_} -> do
@@ -2123,7 +2123,7 @@ updateSupportChatItemsRead db vr user@User {userId} g@GroupInfo {groupId, member
WHERE group_member_id = ?
|]
(currentTs, groupMemberId)
- m_ <- runExceptT $ getGroupMemberById db vr user groupMemberId
+ m_ <- runExceptT $ getGroupMemberById db cxt user groupMemberId
pure $ either (const m) id m_ -- Left shouldn't happen, but types require it
getGroupUnreadTimedItems :: DB.Connection -> User -> GroupId -> Maybe GroupChatScope -> IO [(ChatItemId, Int)]
@@ -2151,8 +2151,8 @@ getGroupUnreadTimedItems db User {userId} groupId scope =
|]
(userId, groupId, GCSTMemberSupport_, groupMemberId_, CISRcvNew)
-updateGroupChatItemsReadList :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> NonEmpty ChatItemId -> ExceptT StoreError IO ([(ChatItemId, Int)], GroupInfo)
-updateGroupChatItemsReadList db vr user@User {userId} g@GroupInfo {groupId} scopeInfo_ itemIds = do
+updateGroupChatItemsReadList :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> NonEmpty ChatItemId -> ExceptT StoreError IO ([(ChatItemId, Int)], GroupInfo)
+updateGroupChatItemsReadList db cxt user@User {userId} g@GroupInfo {groupId} scopeInfo_ itemIds = do
currentTs <- liftIO getCurrentTime
-- Possible improvement is to differentiate retrieval queries for each scope,
-- but we rely on UI to not pass item IDs from incorrect scope.
@@ -2161,7 +2161,7 @@ updateGroupChatItemsReadList db vr user@User {userId} g@GroupInfo {groupId} scop
Nothing -> pure g
Just scopeInfo@GCSIMemberSupport {groupMember_} -> do
let decStats = countReadItems groupMember_ readItemsData
- liftIO $ updateGroupScopeUnreadStats db vr user g scopeInfo decStats
+ liftIO $ updateGroupScopeUnreadStats db cxt user g scopeInfo decStats
pure (timedItems readItemsData, g')
where
getUpdateGroupItem :: UTCTime -> ChatItemId -> IO (Maybe (ChatItemId, Maybe Int, Maybe UTCTime, Maybe GroupMemberId, Maybe BoolInt))
@@ -2196,8 +2196,8 @@ updateGroupChatItemsReadList db vr user@User {userId} g@GroupInfo {groupId} scop
addTimedItem acc (itemId, Just ttl, Nothing, _, _) = (itemId, ttl) : acc
addTimedItem acc _ = acc
-updateGroupScopeUnreadStats :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScopeInfo -> (Int, Int, Int) -> IO GroupInfo
-updateGroupScopeUnreadStats db vr user g@GroupInfo {membership} scopeInfo (unread, unanswered, mentions) =
+updateGroupScopeUnreadStats :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupChatScopeInfo -> (Int, Int, Int) -> IO GroupInfo
+updateGroupScopeUnreadStats db cxt user g@GroupInfo {membership} scopeInfo (unread, unanswered, mentions) =
case scopeInfo of
GCSIMemberSupport {groupMember_} -> case groupMember_ of
Nothing -> do
@@ -2235,7 +2235,7 @@ updateGroupScopeUnreadStats db vr user g@GroupInfo {membership} scopeInfo (unrea
|]
#endif
(unread, unanswered, mentions, currentTs, groupMemberId)
- m_ <- runExceptT $ getGroupMemberById db vr user groupMemberId
+ m_ <- runExceptT $ getGroupMemberById db cxt user groupMemberId
pure $ either (const m) id m_ -- Left shouldn't happen, but types require it
setGroupChatItemsDeleteAt :: DB.Connection -> User -> GroupId -> [(ChatItemId, Int)] -> UTCTime -> IO [(ChatItemId, UTCTime)]
@@ -2410,8 +2410,8 @@ toGroupChatItem
ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
-getAllChatItems :: DB.Connection -> VersionRangeChat -> User -> ChatPagination -> Maybe Text -> ExceptT StoreError IO [AChatItem]
-getAllChatItems db vr user@User {userId} pagination search_ = do
+getAllChatItems :: DB.Connection -> StoreCxt -> User -> ChatPagination -> Maybe Text -> ExceptT StoreError IO [AChatItem]
+getAllChatItems db cxt user@User {userId} pagination search_ = do
itemRefs <-
rights . map toChatItemRef <$> case pagination of
CPLast count -> liftIO $ getAllChatItemsLast_ count
@@ -2423,12 +2423,12 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
liftIO getFirstUnreadItemId_ >>= \case
Just itemId -> liftIO . getAllChatItemsAround_ itemId count . aChatItemTs =<< getAChatItem_ itemId
Nothing -> liftIO $ getAllChatItemsLast_ count
- mapM (uncurry (getAChatItem db vr user)) itemRefs
+ mapM (uncurry (getAChatItem db cxt user)) itemRefs
where
search = fromMaybe "" search_
getAChatItem_ itemId = do
chatRef <- getChatRefViaItemId db user itemId
- getAChatItem db vr user chatRef itemId
+ getAChatItem db cxt user chatRef itemId
getAllChatItemsLast_ count =
reverse
<$> DB.query
@@ -3236,8 +3236,8 @@ deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do
|]
(userId, noteFolderId, itemId)
-getChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO AChatItem
-getChatItemByFileId db vr user@User {userId} fileId = do
+getChatItemByFileId :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO AChatItem
+getChatItemByFileId db cxt user@User {userId} fileId = do
(chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $
DB.query
@@ -3250,16 +3250,16 @@ getChatItemByFileId db vr user@User {userId} fileId = do
LIMIT 1
|]
(userId, fileId)
- getAChatItem db vr user chatRef itemId
+ getAChatItem db cxt user chatRef itemId
-lookupChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
-lookupChatItemByFileId db vr user fileId = do
- fmap Just (getChatItemByFileId db vr user fileId) `catchError` \case
+lookupChatItemByFileId :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
+lookupChatItemByFileId db cxt user fileId = do
+ fmap Just (getChatItemByFileId db cxt user fileId) `catchError` \case
SEChatItemNotFoundByFileId {} -> pure Nothing
e -> throwError e
-getChatItemByGroupId :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO AChatItem
-getChatItemByGroupId db vr user@User {userId} groupId = do
+getChatItemByGroupId :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO AChatItem
+getChatItemByGroupId db cxt user@User {userId} groupId = do
(chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $
DB.query
@@ -3272,7 +3272,7 @@ getChatItemByGroupId db vr user@User {userId} groupId = do
LIMIT 1
|]
(userId, groupId)
- getAChatItem db vr user chatRef itemId
+ getAChatItem db cxt user chatRef itemId
getChatRefViaItemId :: DB.Connection -> User -> ChatItemId -> ExceptT StoreError IO ChatRef
getChatRefViaItemId db User {userId} itemId = do
@@ -3285,17 +3285,17 @@ getChatRefViaItemId db User {userId} itemId = do
(Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId Nothing
(_, _) -> Left $ SEBadChatItem itemId Nothing
-getAChatItem :: DB.Connection -> VersionRangeChat -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
-getAChatItem db vr user (ChatRef cType chatId scope) itemId = do
+getAChatItem :: DB.Connection -> StoreCxt -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
+getAChatItem db cxt user (ChatRef cType chatId scope) itemId = do
aci <- case cType of
CTDirect -> do
- ct <- getContact db vr user chatId
+ ct <- getContact db cxt user chatId
(CChatItem msgDir ci) <- getDirectChatItem db user chatId itemId
pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci
CTGroup -> do
- gInfo <- getGroupInfo db vr user chatId
+ gInfo <- getGroupInfo db cxt user chatId
(CChatItem msgDir ci) <- getGroupChatItem db user chatId itemId
- scopeInfo <- mapM (getGroupChatScopeInfo db vr user gInfo) scope
+ scopeInfo <- mapM (getGroupChatScopeInfo db cxt user gInfo) scope
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo scopeInfo) ci
CTLocal -> do
nf <- getNoteFolder db user chatId
@@ -3471,8 +3471,8 @@ setGroupReaction db GroupInfo {groupId} m itemMemberId itemSharedMId sent reacti
|]
(groupId, groupMemberId' m, itemSharedMId, itemMemberId, BI sent, reaction)
-getReactionMembers :: DB.Connection -> VersionRangeChat -> User -> GroupId -> SharedMsgId -> MsgReaction -> IO [MemberReaction]
-getReactionMembers db vr user groupId itemSharedMId reaction = do
+getReactionMembers :: DB.Connection -> StoreCxt -> User -> GroupId -> SharedMsgId -> MsgReaction -> IO [MemberReaction]
+getReactionMembers db cxt user groupId itemSharedMId reaction = do
reactions <-
DB.query
db
@@ -3486,7 +3486,7 @@ getReactionMembers db vr user groupId itemSharedMId reaction = do
where
toMemberReaction :: (GroupMemberId, UTCTime) -> ExceptT StoreError IO MemberReaction
toMemberReaction (groupMemberId, reactionTs) = do
- groupMember <- getGroupMemberById db vr user groupMemberId
+ groupMember <- getGroupMemberById db cxt user groupMemberId
pure MemberReaction {groupMember, reactionTs}
getTimedItems :: DB.Connection -> User -> UTCTime -> IO [((ChatRef, ChatItemId), UTCTime)]
@@ -3584,9 +3584,9 @@ createCIModeration db GroupInfo {groupId} moderatorMember itemMemberId itemShare
|]
(groupId, groupMemberId' moderatorMember, itemMemberId, itemSharedMId, msgId, moderatedAtTs)
-getCIModeration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
+getCIModeration :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
getCIModeration _ _ _ _ _ Nothing = pure Nothing
-getCIModeration db vr user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
+getCIModeration db cxt user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
r_ <-
maybeFirstRow id $
DB.query
@@ -3600,7 +3600,7 @@ getCIModeration db vr user GroupInfo {groupId} itemMemberId (Just sharedMsgId) =
(groupId, itemMemberId, sharedMsgId)
case r_ of
Just (moderationId, moderatorId, createdByMsgId, moderatedAt) -> do
- runExceptT (getGroupMember db vr user groupId moderatorId) >>= \case
+ runExceptT (getGroupMember db cxt user groupId moderatorId) >>= \case
Right moderatorMember -> pure (Just CIModeration {moderationId, moderatorMember, createdByMsgId, moderatedAt})
_ -> pure Nothing
_ -> pure Nothing
diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs
index da45b43f8f..e52e8268f7 100644
--- a/src/Simplex/Chat/Store/Profiles.hs
+++ b/src/Simplex/Chat/Store/Profiles.hs
@@ -388,9 +388,9 @@ createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMo
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
-getUserAddressConnection :: DB.Connection -> VersionRangeChat -> User -> ExceptT StoreError IO Connection
-getUserAddressConnection db vr User {userId} = do
- ExceptT . firstRow (toConnection vr) SEUserContactLinkNotFound $
+getUserAddressConnection :: DB.Connection -> StoreCxt -> User -> ExceptT StoreError IO Connection
+getUserAddressConnection db cxt User {userId} = do
+ ExceptT . firstRow (toConnection cxt) SEUserContactLinkNotFound $
DB.query
db
[sql|
@@ -533,8 +533,8 @@ setUserContactLinkShortLink db userContactLinkId shortLink =
|]
(shortLink, BI True, BI True, BI False, userContactLinkId)
-getContactWithoutConnViaAddress :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
-getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
+getContactWithoutConnViaAddress :: DB.Connection -> StoreCxt -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
+getContactWithoutConnViaAddress db cxt user@User {userId} (cReqSchema1, cReqSchema2) = do
ctId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -547,10 +547,10 @@ getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchem
WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL
|]
(userId, cReqSchema1, cReqSchema2)
- maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) ctId_
+ maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db cxt user) ctId_
-getContactWithoutConnViaShortAddress :: DB.Connection -> VersionRangeChat -> User -> ShortLinkContact -> IO (Maybe Contact)
-getContactWithoutConnViaShortAddress db vr user@User {userId} shortLink = do
+getContactWithoutConnViaShortAddress :: DB.Connection -> StoreCxt -> User -> ShortLinkContact -> IO (Maybe Contact)
+getContactWithoutConnViaShortAddress db cxt user@User {userId} shortLink = do
ctId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -563,7 +563,7 @@ getContactWithoutConnViaShortAddress db vr user@User {userId} shortLink = do
WHERE cp.user_id = ? AND cp.contact_link = ? AND c.connection_id IS NULL
|]
(userId, shortLink)
- maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) ctId_
+ maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db cxt user) ctId_
updateUserAddressSettings :: DB.Connection -> Int64 -> AddressSettings -> IO ()
updateUserAddressSettings db userContactLinkId AddressSettings {businessAddress, autoAccept, autoReply} =
diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs
index ae33960ab9..41c438099b 100644
--- a/src/Simplex/Chat/Store/Shared.hs
+++ b/src/Simplex/Chat/Store/Shared.hs
@@ -228,12 +228,12 @@ type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, BoolInt, May
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe BoolInt, Maybe GroupLinkId, Maybe XContactId) :. (Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe BoolInt, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQSupport, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe Int, Maybe VersionChat, Maybe VersionChat, Maybe VersionChat)
-toConnection :: VersionRangeChat -> ConnectionRow -> Connection
-toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, BI viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, BI contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, quotaErrCounter, chatV, minVer, maxVer)) =
+toConnection :: StoreCxt -> ConnectionRow -> Connection
+toConnection cxt ((connId, acId, connLevel, viaContact, viaUserContactLink, BI viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, BI contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, quotaErrCounter, chatV, minVer, maxVer)) =
Connection
{ connId,
agentConnId = AgentConnId acId,
- connChatVersion = fromMaybe (vr `peerConnChatVersion` peerChatVRange) chatV,
+ connChatVersion = fromMaybe (vr cxt `peerConnChatVersion` peerChatVRange) chatV,
peerChatVRange = peerChatVRange,
connLevel,
viaContact,
@@ -263,9 +263,9 @@ toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, BI vi
entityId_ ConnMember = groupMemberId
entityId_ ConnUserContact = userContactLinkId
-toMaybeConnection :: VersionRangeChat -> MaybeConnectionRow -> Maybe Connection
-toMaybeConnection vr ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, Just quotaErrCounter, connChatVersion, Just minVer, Just maxVer)) =
- Just $ toConnection vr ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, quotaErrCounter, connChatVersion, minVer, maxVer))
+toMaybeConnection :: StoreCxt -> MaybeConnectionRow -> Maybe Connection
+toMaybeConnection cxt ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, Just quotaErrCounter, connChatVersion, Just minVer, Just maxVer)) =
+ Just $ toConnection cxt ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, xContactId) :. (customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, quotaErrCounter, connChatVersion, minVer, maxVer))
toMaybeConnection _ _ = Nothing
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> ConnStatus -> VersionChat -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQSupport -> IO Connection
@@ -488,10 +488,10 @@ type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe
type ContactRow = Only ContactId :. ContactRow'
-toContact :: VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
-toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
+toContact :: StoreCxt -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
+toContact cxt user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences, localAlias}
- activeConn = toMaybeConnection vr connRow
+ activeConn = toMaybeConnection cxt connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
incognito = maybe False connIncognito activeConn
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
@@ -673,9 +673,9 @@ type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, Ver
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences)
-toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
-toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
- let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
+toGroupInfo :: StoreCxt -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
+toGroupInfo cxt userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
+ let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr cxt}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ (toPublicGroupAccess accessRow)
@@ -756,9 +756,9 @@ groupMemberQuery =
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
|]
-toContactMember :: VersionRangeChat -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
-toContactMember vr User {userContactId} (memberRow :. connRow) =
- (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection vr connRow}
+toContactMember :: StoreCxt -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
+toContactMember cxt User {userContactId} (memberRow :. connRow) =
+ (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection cxt connRow}
rowToLocalProfile :: ProfileRow -> LocalProfile
rowToLocalProfile (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) =
@@ -875,10 +875,10 @@ addGroupChatTags db g@GroupInfo {groupId} = do
chatTags <- getGroupChatTags db groupId
pure (g :: GroupInfo) {chatTags}
-getGroupInfo :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO GroupInfo
-getGroupInfo db vr User {userId, userContactId} groupId = ExceptT $ do
+getGroupInfo :: DB.Connection -> StoreCxt -> User -> Int64 -> ExceptT StoreError IO GroupInfo
+getGroupInfo db cxt User {userId, userContactId} groupId = ExceptT $ do
chatTags <- getGroupChatTags db groupId
- firstRow (toGroupInfo vr userContactId chatTags) (SEGroupNotFound groupId) $
+ firstRow (toGroupInfo cxt userContactId chatTags) (SEGroupNotFound groupId) $
DB.query
db
(groupInfoQuery <> " WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?")
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 141dceaad1..c6c53f69e9 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -2036,6 +2036,10 @@ type VersionChat = Version ChatVersion
type VersionRangeChat = VersionRange ChatVersion
+-- | Store-wide context passed to store functions in place of the bare `vr`
+-- parameter. Built from config by mkStoreCxt; more fields are added here over time.
+newtype StoreCxt = StoreCxt {vr :: VersionRangeChat}
+
pattern VersionChat :: Word16 -> VersionChat
pattern VersionChat v = Version v
diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs
index 131c09cae9..47a4d92456 100644
--- a/tests/ChatTests/Groups.hs
+++ b/tests/ChatTests/Groups.hs
@@ -241,7 +241,7 @@ chatGroupTests = do
-- TODO - cancellation on failure to create relay group (for owner)
-- TODO - async retry connecting to relay (for members)
-- TODO - test relay privileges
- describe "channels" $ do
+ fdescribe "channels" $ do
describe "relay delivery" $ do
describe "single relay" $ do
it "should deliver messages to members" testChannels1RelayDeliver
diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs
index 4987319899..c2c0c9633b 100644
--- a/tests/ChatTests/Utils.hs
+++ b/tests/ChatTests/Utils.hs
@@ -23,7 +23,7 @@ import Data.List (isPrefixOf, isSuffixOf)
import Data.Maybe (fromMaybe)
import Data.String
import qualified Data.Text as T
-import Simplex.Chat.Controller (ChatConfig (..), ChatController (..))
+import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), mkStoreCxt)
import Simplex.Chat.Markdown (viewName)
import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText, e2eInfoPQText)
import Simplex.Chat.Protocol
@@ -702,10 +702,10 @@ getCtConn cc contactId = getTestCCContact cc contactId >>= maybe (fail "no conne
getTestCCContact :: TestCC -> ContactId -> IO Contact
getTestCCContact cc contactId = do
- let TestCC {chatController = ChatController {config = ChatConfig {chatVRange = vr}}} = cc
+ let TestCC {chatController = ChatController {config}} = cc
withCCTransaction cc $ \db ->
withCCUser cc $ \user ->
- runExceptT (getContact db vr user contactId) >>= either (fail . show) pure
+ runExceptT (getContact db (mkStoreCxt config) user contactId) >>= either (fail . show) pure
lastItemId :: HasCallStack => TestCC -> IO String
lastItemId cc = do