core: use version from config, add tests (#3588)

* core: use version from config, add tests

* comment

* refactor
This commit is contained in:
Evgeny Poberezkin
2023-12-24 13:27:51 +00:00
committed by GitHub
parent 5a6670998c
commit af22348bf8
10 changed files with 348 additions and 268 deletions
+13 -12
View File
@@ -35,9 +35,10 @@ import Simplex.Messaging.Agent.Protocol (ConnId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Util (eitherToMaybe)
import Simplex.Messaging.Version (VersionRange)
getConnectionEntity :: DB.Connection -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity db user@User {userId, userContactId} agentConnId = do
getConnectionEntity :: DB.Connection -> VersionRange -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
c@Connection {connType, entityId} <- getConnection_
case entityId of
Nothing ->
@@ -115,7 +116,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
(groupMemberId, userId, userContactId)
toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember)
toGroupAndMember c (groupInfoRow :. memberRow) =
let groupInfo = toGroupInfo userContactId groupInfoRow
let groupInfo = toGroupInfo vr userContactId groupInfoRow
member = toGroupMember userContactId memberRow
in (groupInfo, (member :: GroupMember) {activeConn = Just c})
getConnSndFileTransfer_ :: Int64 -> Connection -> ExceptT StoreError IO SndFileTransfer
@@ -154,19 +155,19 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
userContact_ _ = Left SEUserContactLinkNotFound
getConnectionEntityByConnReq :: DB.Connection -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq db user@User {userId} (cReqSchema1, cReqSchema2) = do
getConnectionEntityByConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq db vr 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 user) connId_
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
-- search connection for connection plan:
-- 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 -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash db user@User {userId} (cReqHash1, cReqHash2) = do
getContactConnEntityByConnReqHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2) = do
connId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -183,14 +184,14 @@ getContactConnEntityByConnReqHash db user@User {userId} (cReqHash1, cReqHash2) =
)
|]
(userId, cReqHash1, cReqHash2, ConnDeleted)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db user) connId_
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
getConnectionsToSubscribe :: DB.Connection -> IO ([ConnId], [ConnectionEntity])
getConnectionsToSubscribe db = do
getConnectionsToSubscribe :: DB.Connection -> VersionRange -> IO ([ConnId], [ConnectionEntity])
getConnectionsToSubscribe db vr = do
aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1"
entities <- forM aConnIds $ \acId -> do
getUserByAConnId db acId >>= \case
Just user -> eitherToMaybe <$> runExceptT (getConnectionEntity db user acId)
Just user -> eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId)
Nothing -> pure Nothing
unsetConnectionToSubscribe db
let connIds = map (\(AgentConnId connId) -> connId) aConnIds
+13 -12
View File
@@ -107,6 +107,7 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Version (VersionRange)
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
getLiveSndFileTransfers db User {userId} = do
@@ -677,8 +678,8 @@ getRcvFileTransfer_ db userId fileId = do
_ -> pure Nothing
cancelled = fromMaybe False cancelled_
acceptRcvFileTransfer :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer db user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do
acceptRcvFileTransfer :: DB.Connection -> VersionRange -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do
currentTs <- getCurrentTime
acceptRcvFT_ db user fileId filePath Nothing currentTs
DB.execute
@@ -687,7 +688,7 @@ acceptRcvFileTransfer db user@User {userId} fileId (cmdId, acId) connStatus file
(acId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs, subMode == SMOnlyCreate)
connId <- insertedRowId db
setCommandConnId db user cmdId connId
runExceptT $ getChatItemByFileId db user fileId
runExceptT $ getChatItemByFileId db vr user fileId
getContactByFileId :: DB.Connection -> User -> FileTransferId -> ExceptT StoreError IO Contact
getContactByFileId db user@User {userId} fileId = do
@@ -698,19 +699,19 @@ getContactByFileId db user@User {userId} fileId = do
ExceptT . firstRow fromOnly (SEContactNotFoundByFileId fileId) $
DB.query db "SELECT contact_id FROM files WHERE user_id = ? AND file_id = ?" (userId, fileId)
acceptRcvInlineFT :: DB.Connection -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvInlineFT db user fileId filePath = do
acceptRcvInlineFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvInlineFT db vr user fileId filePath = do
liftIO $ acceptRcvFT_ db user fileId filePath (Just IFMOffer) =<< getCurrentTime
getChatItemByFileId db user fileId
getChatItemByFileId db vr user fileId
startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Maybe InlineFileMode -> IO ()
startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline =
acceptRcvFT_ db user fileId filePath rcvFileInline =<< getCurrentTime
xftpAcceptRcvFT :: DB.Connection -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
xftpAcceptRcvFT db user fileId filePath = do
xftpAcceptRcvFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
xftpAcceptRcvFT db vr user fileId filePath = do
liftIO $ acceptRcvFT_ db user fileId filePath Nothing =<< getCurrentTime
getChatItemByFileId db user fileId
getChatItemByFileId db vr user fileId
acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Maybe InlineFileMode -> UTCTime -> IO ()
acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
@@ -930,9 +931,9 @@ getLocalCryptoFile db userId fileId sent =
FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId
pure $ CryptoFile filePath $ xftpSndFile >>= \f -> f.cryptoArgs
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
updateDirectCIFileStatus db user fileId fileStatus = do
aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRange -> 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
case (cType, testEquality d $ msgDirection @d) of
(SCTDirect, Just Refl) -> do
liftIO $ updateCIFileStatus db user fileId fileStatus
+58 -57
View File
@@ -128,7 +128,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Messages
import Simplex.Chat.Protocol (currentChatVersion, groupForwardVRange, supportedChatVRange)
import Simplex.Chat.Protocol (groupForwardVRange)
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
@@ -148,9 +148,9 @@ type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRol
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange supportedChatVRange}
toGroupInfo :: VersionRange -> Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange vr}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
@@ -252,8 +252,8 @@ setGroupLinkMemberRole :: DB.Connection -> User -> Int64 -> GroupMemberRole -> I
setGroupLinkMemberRole db User {userId} userContactLinkId memberRole =
DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId)
getGroupAndMember :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember db User {userId, userContactId} groupMemberId =
getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRange -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember db User {userId, userContactId} groupMemberId vr =
ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
DB.query
db
@@ -289,13 +289,13 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
where
toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember)
toGroupAndMember (groupInfoRow :. memberRow :. connRow) =
let groupInfo = toGroupInfo userContactId groupInfoRow
let groupInfo = toGroupInfo vr userContactId groupInfoRow
member = toGroupMember userContactId memberRow
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
-- | creates completely new group with a single member - the current user
createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo
createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do
createNewGroup :: DB.Connection -> VersionRange -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo
createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do
let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile
fullGroupPreferences = mergeGroupPreferences groupPreferences
currentTs <- getCurrentTime
@@ -313,18 +313,18 @@ createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = Except
(ldn, userId, profileId, True, currentTs, currentTs, currentTs)
insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs supportedChatVRange
membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs vr
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}
-- | creates a new group record for the group the current user was invited to, or returns an existing one
createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Just hostConn@Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
createGroupInvitation :: DB.Connection -> VersionRange -> 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 hostConn@Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
liftIO getInvitationGroupId_ >>= \case
Nothing -> createGroupInvitation_
Just gId -> do
gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db user gId
gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db vr user gId
hostId <- getHostMemberId_ db user gId
let GroupMember {groupMemberId, memberId, memberRole} = membership
MemberIdRole {memberId = memberId', memberRole = memberRole'} = invitedMember
@@ -360,7 +360,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
insertedRowId db
let JVersionRange hostVRange = hostConn.peerChatVRange
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs supportedChatVRange
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId)
@@ -431,9 +431,10 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
)
pure $ Right incognitoLdn
createGroupInvitedViaLink :: DB.Connection -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink :: DB.Connection -> VersionRange -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink
db
vr
user@User {userId, userContactId}
Connection {connId, customUserProfileId}
GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile} = do
@@ -442,9 +443,9 @@ createGroupInvitedViaLink
hostMemberId <- insertHost_ currentTs groupId
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
void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs supportedChatVRange
void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs vr
liftIO $ setViaGroupLinkHash db groupId connId
(,) <$> getGroupInfo db user groupId <*> getGroupMemberById db user hostMemberId
(,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db user hostMemberId
where
insertGroup_ currentTs = ExceptT $ do
let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile
@@ -497,9 +498,9 @@ 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 -> User -> GroupId -> ExceptT StoreError IO Group
getGroup db user groupId = do
gInfo <- getGroupInfo db user groupId
getGroup :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO Group
getGroup db vr user groupId = do
gInfo <- getGroupInfo db vr user groupId
members <- liftIO $ getGroupMembers db user gInfo
pure $ Group gInfo members
@@ -552,14 +553,14 @@ deleteGroupProfile_ db userId groupId =
|]
(userId, groupId)
getUserGroups :: DB.Connection -> User -> IO [Group]
getUserGroups db user@User {userId} = do
getUserGroups :: DB.Connection -> VersionRange -> User -> IO [Group]
getUserGroups db vr user@User {userId} = do
groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId)
rights <$> mapM (runExceptT . getGroup db user) groupIds
rights <$> mapM (runExceptT . getGroup db vr user) groupIds
getUserGroupDetails :: DB.Connection -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
getUserGroupDetails db User {userId, userContactId} _contactId_ search_ =
map (toGroupInfo userContactId)
getUserGroupDetails :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
map (toGroupInfo vr userContactId)
<$> DB.query
db
[sql|
@@ -577,9 +578,9 @@ getUserGroupDetails db User {userId, userContactId} _contactId_ search_ =
where
search = fromMaybe "" search_
getUserGroupsWithSummary :: DB.Connection -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)]
getUserGroupsWithSummary db user _contactId_ search_ =
getUserGroupDetails db user _contactId_ search_
getUserGroupsWithSummary :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)]
getUserGroupsWithSummary db vr user _contactId_ search_ =
getUserGroupDetails db vr user _contactId_ search_
>>= mapM (\g@GroupInfo {groupId} -> (g,) <$> getGroupSummary db user groupId)
-- the statuses on non-current members should match memberCurrent' function
@@ -620,10 +621,10 @@ checkContactHasGroups :: DB.Connection -> User -> Contact -> IO (Maybe GroupId)
checkContactHasGroups db User {userId} Contact {contactId} =
maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
getGroupInfoByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupInfo
getGroupInfoByName db user gName = do
getGroupInfoByName :: DB.Connection -> VersionRange -> User -> GroupName -> ExceptT StoreError IO GroupInfo
getGroupInfoByName db vr user gName = do
gId <- getGroupIdByName db user gName
getGroupInfo db user gId
getGroupInfo db vr user gId
groupMemberQuery :: Query
groupMemberQuery =
@@ -709,11 +710,11 @@ getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
(groupId, userId)
pure $ length $ filter memberCurrent' statuses
getGroupInvitation :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation db user groupId =
getGroupInvitation :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation db vr user groupId =
getConnRec_ user >>= \case
Just connRequest -> do
groupInfo@GroupInfo {membership} <- getGroupInfo db user groupId
groupInfo@GroupInfo {membership} <- getGroupInfo db vr user groupId
when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined
hostId <- getHostMemberId_ db user groupId
fromMember <- getGroupMember db user groupId hostId
@@ -1005,8 +1006,8 @@ updateGroupMemberRole :: DB.Connection -> User -> GroupMember -> GroupMemberRole
updateGroupMemberRole db User {userId} GroupMember {groupMemberId} memRole =
DB.execute db "UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?" (memRole, userId, groupMemberId)
createIntroductions :: DB.Connection -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro]
createIntroductions db members toMember = do
createIntroductions :: DB.Connection -> Version -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro]
createIntroductions db chatV members toMember = do
let reMembers = filter (\m -> memberCurrent m && groupMemberId' m /= groupMemberId' toMember) members
if null reMembers
then pure []
@@ -1023,7 +1024,7 @@ createIntroductions db members toMember = do
(re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at)
VALUES (?,?,?,?,?,?)
|]
(groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, currentChatVersion, ts, ts)
(groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, chatV, ts, ts)
introId <- insertedRowId db
pure GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending, introInvitation = Nothing}
@@ -1201,8 +1202,8 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRange -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange viaContact = createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing
getViaGroupMember :: DB.Connection -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
getViaGroupMember db User {userId, userContactId} Contact {contactId} =
getViaGroupMember :: DB.Connection -> VersionRange -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
maybeFirstRow toGroupAndMember $
DB.query
db
@@ -1239,7 +1240,7 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
where
toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember)
toGroupAndMember (groupInfoRow :. memberRow :. connRow) =
let groupInfo = toGroupInfo userContactId groupInfoRow
let groupInfo = toGroupInfo vr userContactId groupInfoRow
member = toGroupMember userContactId memberRow
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
@@ -1294,9 +1295,9 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou
(ldn, currentTs, userId, groupId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
getGroupInfo :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO GroupInfo
getGroupInfo db User {userId, userContactId} groupId =
ExceptT . firstRow (toGroupInfo userContactId) (SEGroupNotFound groupId) $
getGroupInfo :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO GroupInfo
getGroupInfo db vr User {userId, userContactId} groupId =
ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $
DB.query
db
[sql|
@@ -1315,8 +1316,8 @@ getGroupInfo db User {userId, userContactId} groupId =
|]
(groupId, userId, userContactId)
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq db user@User {userId} (cReqSchema1, cReqSchema2) = do
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
groupId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -1327,10 +1328,10 @@ getGroupInfoByUserContactLinkConnReq db user@User {userId} (cReqSchema1, cReqSch
WHERE user_id = ? AND conn_req_contact IN (?,?)
|]
(userId, cReqSchema1, cReqSchema2)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_
getGroupInfoByGroupLinkHash :: DB.Connection -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash db user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do
getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash db vr user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do
groupId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -1344,7 +1345,7 @@ getGroupInfoByGroupLinkHash db user@User {userId, userContactId} (groupLinkHash1
LIMIT 1
|]
(userId, groupLinkHash1, groupLinkHash2, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_
getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId
getGroupIdByName db User {userId} gName =
@@ -1356,8 +1357,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 -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName db user@User {userId} groupMemberName = do
getActiveMembersByName :: DB.Connection -> VersionRange -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName db vr user@User {userId} groupMemberName = do
groupMemberIds :: [(GroupId, GroupMemberId)] <-
liftIO $
DB.query
@@ -1370,7 +1371,7 @@ getActiveMembersByName db user@User {userId} groupMemberName = do
|]
(userId, groupMemberName, GSMemConnected, GSMemComplete, GCUserMember)
possibleMembers <- forM groupMemberIds $ \(groupId, groupMemberId) -> do
groupInfo <- getGroupInfo db user groupId
groupInfo <- getGroupInfo db vr user groupId
groupMember <- getGroupMember db user groupId groupMemberId
pure (groupInfo, groupMember)
pure $ sortOn (Down . ts . fst) possibleMembers
@@ -1827,15 +1828,15 @@ createMemberContact
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
getMemberContact :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db user contactId = do
getMemberContact :: DB.Connection -> VersionRange -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db vr user contactId = do
ct <- getContact db 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 user groupMemberId
g <- getGroupInfo db user groupId
g <- getGroupInfo db vr user groupId
pure (g, m, ct, cReq)
_ ->
throwError $ SEMemberContactGroupMemberNotFound contactId
+23 -22
View File
@@ -134,6 +134,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import Simplex.Messaging.Util (eitherToMaybe)
import Simplex.Messaging.Version (VersionRange)
import UnliftIO.STM
deleteContactCIs :: DB.Connection -> User -> Contact -> IO ()
@@ -461,8 +462,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 -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
getChatPreviews db user withPCC pagination query = do
getChatPreviews :: DB.Connection -> VersionRange -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
getChatPreviews db vr user withPCC pagination query = do
directChats <- findDirectChatPreviews_ db user pagination query
groupChats <- findGroupChatPreviews_ db user pagination query
cReqChats <- getContactRequestChatPreviews_ db user pagination query
@@ -483,7 +484,7 @@ getChatPreviews db user withPCC pagination query = do
getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat
getChatPreview (ACPD cType cpd) = case cType of
SCTDirect -> getDirectChatPreview_ db user cpd
SCTGroup -> getGroupChatPreview_ db user cpd
SCTGroup -> getGroupChatPreview_ db vr user cpd
SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat
SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat
@@ -688,9 +689,9 @@ findGroupChatPreviews_ db User {userId} pagination clq =
)
([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams)
getGroupChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
getGroupChatPreview_ db user (GroupChatPD _ groupId lastItemId_ stats) = do
groupInfo <- getGroupInfo db user groupId
getGroupChatPreview_ :: DB.Connection -> VersionRange -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do
groupInfo <- getGroupInfo db vr user groupId
lastItem <- case lastItemId_ of
Just lastItemId -> (: []) <$> getGroupChatItem db user groupId lastItemId
Nothing -> pure []
@@ -874,10 +875,10 @@ getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId co
|]
(userId, contactId, search, beforeChatItemId, count)
getGroupChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChat db user groupId pagination search_ = do
getGroupChat :: DB.Connection -> VersionRange -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChat db vr user groupId pagination search_ = do
let search = fromMaybe "" search_
g <- getGroupInfo db user groupId
g <- getGroupInfo db vr user groupId
case pagination of
CPLast count -> getGroupChatLast_ db user g count search
CPAfter afterId count -> getGroupChatAfter_ db user g afterId count search
@@ -1185,19 +1186,19 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
getAllChatItems db user@User {userId} pagination search_ = do
getAllChatItems :: DB.Connection -> VersionRange -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
getAllChatItems db vr user@User {userId} pagination search_ = do
itemRefs <-
rights . map toChatItemRef <$> case pagination of
CPLast count -> liftIO $ getAllChatItemsLast_ count
CPAfter afterId count -> liftIO . getAllChatItemsAfter_ afterId count . aChatItemTs =<< getAChatItem_ afterId
CPBefore beforeId count -> liftIO . getAllChatItemsBefore_ beforeId count . aChatItemTs =<< getAChatItem_ beforeId
mapM (uncurry (getAChatItem db user) >=> liftIO . getACIReactions db) itemRefs
mapM (uncurry (getAChatItem db vr user) >=> liftIO . getACIReactions db) itemRefs
where
search = fromMaybe "" search_
getAChatItem_ itemId = do
chatRef <- getChatRefViaItemId db user itemId
getAChatItem db user chatRef itemId
getAChatItem db vr user chatRef itemId
getAllChatItemsLast_ count =
reverse
<$> DB.query
@@ -1713,8 +1714,8 @@ getGroupChatItemIdByText' db User {userId} groupId msg =
|]
(userId, groupId, msg <> "%")
getChatItemByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO AChatItem
getChatItemByFileId db user@User {userId} fileId = do
getChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO AChatItem
getChatItemByFileId db vr user@User {userId} fileId = do
(chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $
DB.query
@@ -1727,10 +1728,10 @@ getChatItemByFileId db user@User {userId} fileId = do
LIMIT 1
|]
(userId, fileId)
getAChatItem db user chatRef itemId
getAChatItem db vr user chatRef itemId
getChatItemByGroupId :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO AChatItem
getChatItemByGroupId db user@User {userId} groupId = do
getChatItemByGroupId :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO AChatItem
getChatItemByGroupId db vr user@User {userId} groupId = do
(chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $
DB.query
@@ -1743,7 +1744,7 @@ getChatItemByGroupId db user@User {userId} groupId = do
LIMIT 1
|]
(userId, groupId)
getAChatItem db user chatRef itemId
getAChatItem db vr user chatRef itemId
getChatRefViaItemId :: DB.Connection -> User -> ChatItemId -> ExceptT StoreError IO ChatRef
getChatRefViaItemId db User {userId} itemId = do
@@ -1755,14 +1756,14 @@ getChatRefViaItemId db User {userId} itemId = do
(Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId
(_, _) -> Left $ SEBadChatItem itemId
getAChatItem :: DB.Connection -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem db user chatRef itemId = case chatRef of
getAChatItem :: DB.Connection -> VersionRange -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem db vr user chatRef itemId = case chatRef of
ChatRef CTDirect contactId -> do
ct <- getContact db user contactId
(CChatItem msgDir ci) <- getDirectChatItem db user contactId itemId
pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci
ChatRef CTGroup groupId -> do
gInfo <- getGroupInfo db user groupId
gInfo <- getGroupInfo db vr user groupId
(CChatItem msgDir ci) <- getGroupChatItem db user groupId itemId
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci
_ -> throwError $ SEChatItemNotFound itemId