dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-07-09 18:51:45 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into sh/namespace

Browse Source 
# Conflicts:
#	src/Simplex/Chat/Library/Commands.hs
#	src/Simplex/Chat/Library/Subscriber.hs
#	src/Simplex/Chat/Store/Direct.hs
#	src/Simplex/Chat/Store/Groups.hs
#	src/Simplex/Chat/Store/Shared.hs
This commit is contained in:
shum
2026-06-08 16:06:27 +00:00
parent 5ce9e852a3 503d091ec4
commit 613eb421da
107 changed files with 2612 additions and 1684 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Connections.hs
+13 -13
View File
@@ -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|
@@ -175,7 +175,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
@@ -194,17 +194,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") $
@@ -225,8 +225,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
@@ -243,7 +243,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 =
src/Simplex/Chat/Store/ContactRequest.hs
+10 -10
View File
@@ -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
src/Simplex/Chat/Store/Delivery.hs
+5 -5
View File
@@ -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 =
src/Simplex/Chat/Store/Direct.hs
+47 -47
View File
@@ -249,8 +249,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
@@ -267,7 +267,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
@@ -291,13 +291,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|
@@ -311,10 +311,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|
@@ -405,19 +405,19 @@ createIncognitoProfile db User {userId} p = do
-- contact_profiles row whose peer-claimed simplex_name was cleared to make
-- room for the new contact's claim, so the caller can emit
-- CEvtSimplexNameConflict.
createPreparedContact :: DB.Connection -> VersionRangeChat -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> Maybe SimplexNameInfo -> ExceptT StoreError IO (Contact, Maybe ContactName)
createPreparedContact db vr user p connLinkToConnect welcomeSharedMsgId simplexName = do
createPreparedContact :: DB.Connection -> StoreCxt -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> Maybe SimplexNameInfo -> ExceptT StoreError IO (Contact, Maybe ContactName)
createPreparedContact db cxt user p connLinkToConnect welcomeSharedMsgId simplexName = do
currentTs <- liftIO getCurrentTime
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
ctUserPreferences = newContactUserPrefs user p
(contactId, displaced) <- createContact_ db user p ctUserPreferences prepared "" currentTs simplexName
ct <- getContact db vr user contactId
ct <- getContact db cxt user contactId
pure (ct, displaced)
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
@@ -450,16 +450,16 @@ updatePreparedContactUser
|]
(newUserId, currentTs, contactId)
safeDeleteLDN db user oldLDN
getContact db vr newUser contactId
getContact db cxt newUser contactId
-- | Returns (contact, displaced) — see createPreparedContact for displaced.
createDirectContact :: DB.Connection -> VersionRangeChat -> User -> Connection -> Profile -> Maybe SimplexNameInfo -> ExceptT StoreError IO (Contact, Maybe ContactName)
createDirectContact db vr user Connection {connId, localAlias} p simplexName = do
createDirectContact :: DB.Connection -> StoreCxt -> User -> Connection -> Profile -> Maybe SimplexNameInfo -> ExceptT StoreError IO (Contact, Maybe ContactName)
createDirectContact db cxt user Connection {connId, localAlias} p simplexName = do
currentTs <- liftIO getCurrentTime
let ctUserPreferences = newContactUserPrefs user p
(contactId, displaced) <- createContact_ db user p ctUserPreferences Nothing localAlias currentTs simplexName
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
ct <- getContact db vr user contactId
ct <- getContact db cxt user contactId
pure (ct, displaced)
deleteContactConnections :: DB.Connection -> User -> Contact -> IO ()
@@ -514,13 +514,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 =
@@ -801,16 +801,16 @@ 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
getContactBySimplexName :: DB.Connection -> VersionRangeChat -> User -> SimplexNameInfo -> ExceptT StoreError IO (Maybe Contact)
getContactBySimplexName db vr user ni =
getContactBySimplexName :: DB.Connection -> StoreCxt -> User -> SimplexNameInfo -> ExceptT StoreError IO (Maybe Contact)
getContactBySimplexName db cxt user ni =
liftIO (getContactIdBySimplexName db user ni) >>= \case
Nothing -> pure Nothing
Just cId -> Just <$> getContact db vr user cId
Just cId -> Just <$> getContact db cxt user cId
getContactIdBySimplexName :: DB.Connection -> User -> SimplexNameInfo -> IO (Maybe Int64)
getContactIdBySimplexName db User {userId} ni =
@@ -823,10 +823,10 @@ getContactIdBySimplexName db User {userId} ni =
|]
(userId, ni)
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)
@@ -954,22 +954,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|
@@ -996,8 +996,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_ =
@@ -1014,11 +1014,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|
src/Simplex/Chat/Store/Files.hs
+9 -9
View File
@@ -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
src/Simplex/Chat/Store/Groups.hs
+216 -216
View File
@@ -257,9 +257,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 Nothing
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|
@@ -354,8 +354,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)
@@ -399,7 +399,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
@@ -431,13 +431,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
@@ -476,9 +476,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 -> Maybe SimplexNameInfo -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember)
createPreparedGroup db gVar vr user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ simplexName = do
createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> StoreCxt -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> Maybe SimplexNameInfo -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember)
createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ simplexName = do
currentTs <- liftIO getCurrentTime
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
(groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs simplexName
@@ -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,16 +1047,16 @@ 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
getGroupInfoBySimplexName :: DB.Connection -> VersionRangeChat -> User -> SimplexNameInfo -> ExceptT StoreError IO (Maybe GroupInfo)
getGroupInfoBySimplexName db vr user ni =
getGroupInfoBySimplexName :: DB.Connection -> StoreCxt -> User -> SimplexNameInfo -> ExceptT StoreError IO (Maybe GroupInfo)
getGroupInfoBySimplexName db cxt user ni =
liftIO (getGroupIdBySimplexName db user ni) >>= \case
Nothing -> pure Nothing
Just gId -> Just <$> getGroupInfo db vr user gId
Just gId -> Just <$> getGroupInfo db cxt user gId
-- | Unlike the parallel 'getContactBySimplexName' lookup (which filters
-- @ct.deleted = 0@ to match the @idx_contacts_simplex_name@ partial index),
@@ -1078,17 +1078,17 @@ getGroupIdBySimplexName db User {userId} ni =
maybeFirstRow fromOnly $
DB.query db "SELECT group_id FROM groups WHERE user_id = ? AND simplex_name = ?" (userId, ni)
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 = ?")
@@ -1127,54 +1127,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
@@ -1193,59 +1193,59 @@ 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 (?,?,?)")
(userId, groupId, userContactId, GRModerator, GRAdmin, 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
@@ -1260,22 +1260,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
@@ -1413,8 +1413,8 @@ toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, f
relayCap = RelayCapabilities {webDomain}
in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink, relayCap}
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
@@ -1433,14 +1433,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)
@@ -1471,10 +1471,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
@@ -1491,7 +1491,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 =
@@ -1508,8 +1508,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)
setRelayLinkAccepted :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> MemberKey -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay)
setRelayLinkAccepted db vr user m (MemberKey relayKey) profile = do
setRelayLinkAccepted :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberKey -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay)
setRelayLinkAccepted db cxt user m (MemberKey relayKey) profile = do
let gmId = groupMemberId' m
currentTs <- liftIO getCurrentTime
liftIO $ DB.execute
@@ -1529,7 +1529,7 @@ setRelayLinkAccepted 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
@@ -1597,8 +1597,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
@@ -1619,9 +1619,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 =
@@ -1673,8 +1673,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
@@ -1687,7 +1687,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 =
@@ -1706,9 +1706,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
@@ -1716,10 +1716,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
@@ -1831,10 +1831,10 @@ createJoiningMemberConnection
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV cReqChatVRange Nothing (Just uclId) Nothing 0 createdAt subMode PQSupportOff Nothing
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
@@ -1846,8 +1846,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
@@ -1870,7 +1870,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 =
@@ -1894,8 +1894,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) $
@@ -1909,7 +1909,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
@@ -1936,18 +1936,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))
@@ -1963,13 +1963,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
@@ -2539,8 +2539,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, simplexName = decodeSimplexName simplexNameRaw, 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 $
@@ -2552,12 +2552,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") $
@@ -2574,14 +2574,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
@@ -2595,7 +2595,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 =
@@ -2607,8 +2607,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
@@ -2621,17 +2621,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
@@ -2646,10 +2646,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 =
@@ -2663,11 +2663,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|
@@ -2700,8 +2700,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
@@ -2722,7 +2722,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
@@ -2732,8 +2732,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
@@ -2753,11 +2753,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 =
@@ -2776,11 +2776,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 ()
@@ -2801,10 +2801,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
@@ -2828,7 +2828,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 =
@@ -2985,15 +2985,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, simplexName = Nothing, simplexNameVerifiedAt = 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
@@ -3102,13 +3102,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
@@ -3190,8 +3190,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
@@ -3211,12 +3211,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
@@ -3236,15 +3236,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 $
@@ -3260,12 +3260,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 $
@@ -3286,7 +3286,7 @@ 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
src/Simplex/Chat/Store/Messages.hs
+65 -65
View File
@@ -406,8 +406,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
@@ -516,7 +516,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
@@ -530,8 +530,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')
@@ -542,7 +542,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
@@ -733,8 +733,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
@@ -756,8 +756,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
@@ -874,9 +874,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
@@ -985,9 +985,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
@@ -1223,10 +1223,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
@@ -1443,11 +1443,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
@@ -1457,31 +1457,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}
@@ -2087,8 +2087,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
@@ -2126,7 +2126,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)]
@@ -2154,8 +2154,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.
@@ -2164,7 +2164,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))
@@ -2199,8 +2199,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
@@ -2238,7 +2238,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)]
@@ -2413,8 +2413,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
@@ -2426,12 +2426,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
@@ -3239,8 +3239,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
@@ -3253,16 +3253,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
@@ -3275,7 +3275,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
@@ -3288,17 +3288,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
@@ -3474,8 +3474,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
@@ -3489,7 +3489,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)]
@@ -3587,9 +3587,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
@@ -3603,7 +3603,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
src/Simplex/Chat/Store/Profiles.hs
+9 -9
View File
@@ -394,9 +394,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 Nothing
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|
@@ -539,8 +539,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
@@ -553,10 +553,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
@@ -569,7 +569,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} =
src/Simplex/Chat/Store/Shared.hs
+18 -18
View File
@@ -236,12 +236,12 @@ type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Ma
decodeSimplexName :: Maybe Text -> Maybe SimplexNameInfo
decodeSimplexName = (>>= eitherToMaybe . strDecode . encodeUtf8)
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) :. Only simplexNameRaw) =
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) :. Only simplexNameRaw) =
Connection
{ connId,
agentConnId = AgentConnId acId,
connChatVersion = fromMaybe (vr `peerConnChatVersion` peerChatVRange) chatV,
connChatVersion = fromMaybe (vr cxt `peerConnChatVersion` peerChatVRange) chatV,
peerChatVRange = peerChatVRange,
connLevel,
viaContact,
@@ -272,9 +272,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) :. Only simplexNameRaw) =
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) :. Only simplexNameRaw)
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) :. Only simplexNameRaw) =
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) :. Only simplexNameRaw)
toMaybeConnection _ _ = Nothing
-- | Creates a new connection row. The @simplexName@ argument is a TRANSIENT
@@ -555,11 +555,11 @@ type ContactRow = Only ContactId :. ContactRow'
-- ct.simplex_name -> Contact.simplexName (user's locally-known label)
-- cp.simplex_name -> LocalProfile.simplexName (peer's broadcast claim)
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, ctSimplexNameRaw, cpSimplexNameRaw, simplexNameVerifiedAt)) :. 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, ctSimplexNameRaw, cpSimplexNameRaw, simplexNameVerifiedAt)) :. connRow) =
let simplexName = decodeSimplexName ctSimplexNameRaw
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName cpSimplexNameRaw, 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
@@ -741,9 +741,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, Maybe Text)
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, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. (gSimplexNameRaw, gpSimplexNameRaw, simplexNameVerifiedAt) :. 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, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. (gSimplexNameRaw, gpSimplexNameRaw, simplexNameVerifiedAt) :. 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)
@@ -829,9 +829,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, simplexNameRaw) =
@@ -950,10 +950,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 = ?")