Merge branch 'master' into master-ghc8107

src/Simplex/Chat/Store/Groups.hs

@@ -28,6 +28,7 @@ module Simplex.Chat.Store.Groups
     getGroupAndMember,
     createNewGroup,
     createGroupInvitation,
+    createGroupInvitedViaLink,
     setViaGroupLinkHash,
     setGroupInvitationChatItemId,
     getGroup,
@@ -56,6 +57,8 @@ module Simplex.Chat.Store.Groups
     getGroupInvitation,
     createNewContactMember,
     createNewContactMemberAsync,
+    createAcceptedMember,
+    createAcceptedMemberConnection,
     getContactViaMember,
     setNewContactMemberConnRequest,
     getMemberInvitation,
@@ -99,6 +102,9 @@ module Simplex.Chat.Store.Groups
     createMemberContactInvited,
     updateMemberContactInvited,
     resetMemberContactFields,
+    updateMemberProfile,
+    getXGrpLinkMemReceived,
+    setXGrpLinkMemReceived,
   )
 where
 
@@ -407,6 +413,54 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
           )
         pure $ Right incognitoLdn
 
+createGroupInvitedViaLink :: DB.Connection -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
+createGroupInvitedViaLink
+  db
+  user@User {userId, userContactId}
+  Connection {connId, customUserProfileId}
+  GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile} = do
+    currentTs <- liftIO getCurrentTime
+    groupId <- insertGroup_ currentTs
+    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 user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs
+    liftIO $ setViaGroupLinkHash db groupId connId
+    (,) <$> getGroupInfo db user groupId <*> getGroupMemberById db user hostMemberId
+  where
+    insertGroup_ currentTs = ExceptT $ do
+      let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile
+      withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
+        liftIO $ do
+          DB.execute
+            db
+            "INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
+            (displayName, fullName, description, image, userId, groupPreferences, currentTs, currentTs)
+          profileId <- insertedRowId db
+          DB.execute
+            db
+            "INSERT INTO groups (group_profile_id, local_display_name, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?)"
+            (profileId, localDisplayName, customUserProfileId, userId, True, currentTs, currentTs, currentTs)
+          insertedRowId db
+    insertHost_ currentTs groupId = ExceptT $ do
+      let fromMemberProfile = profileFromName fromMemberName
+      withLocalDisplayName db userId fromMemberName $ \localDisplayName -> runExceptT $ do
+        (_, profileId) <- createNewMemberProfile_ db user fromMemberProfile currentTs
+        let MemberIdRole {memberId, memberRole} = fromMember
+        liftIO $ do
+          DB.execute
+            db
+            [sql|
+              INSERT INTO group_members
+                ( group_id, member_id, member_role, member_category, member_status, invited_by,
+                  user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
+              VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
+            |]
+            ( (groupId, memberId, memberRole, GCHostMember, GSMemAccepted, fromInvitedBy userContactId IBUnknown)
+                :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
+            )
+          insertedRowId db
+
 setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO ()
 setViaGroupLinkHash db groupId connId =
   DB.execute
@@ -708,6 +762,47 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
             :. (userId, localDisplayName, contactId, localProfileId profile, createdAt, createdAt)
         )
 
+createAcceptedMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> ExceptT StoreError IO (GroupMemberId, MemberId)
+createAcceptedMember
+  db
+  gVar
+  User {userId, userContactId}
+  GroupInfo {groupId}
+  UserContactRequest {localDisplayName, profileId}
+  memberRole = do
+    liftIO $
+      DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+    createWithRandomId gVar $ \memId -> do
+      createdAt <- liftIO getCurrentTime
+      insertMember_ (MemberId memId) createdAt
+      groupMemberId <- liftIO $ insertedRowId db
+      pure (groupMemberId, MemberId memId)
+  where
+    insertMember_ memberId createdAt =
+      DB.execute
+        db
+        [sql|
+          INSERT INTO group_members
+            ( group_id, member_id, member_role, member_category, member_status, invited_by,
+              user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
+          VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
+        |]
+        ( (groupId, memberId, memberRole, GCInviteeMember, GSMemAccepted, fromInvitedBy userContactId IBUser)
+            :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, createdAt, createdAt)
+        )
+
+createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
+createAcceptedMemberConnection
+  db
+  user@User {userId}
+  (cmdId, agentConnId)
+  UserContactRequest {cReqChatVRange, userContactLinkId}
+  groupMemberId
+  subMode = do
+    createdAt <- liftIO getCurrentTime
+    Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId (fromJVersionRange cReqChatVRange) Nothing (Just userContactLinkId) Nothing 0 createdAt subMode
+    setCommandConnId db user cmdId connId
+
 getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact
 getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do
   contactId <-
@@ -763,9 +858,9 @@ updateGroupMemberStatusById db userId groupMemberId memStatus = do
 
 -- | add new member with profile
 createNewGroupMember :: DB.Connection -> User -> GroupInfo -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
-createNewGroupMember db user gInfo memInfo memCategory memStatus = do
+createNewGroupMember db user gInfo memInfo@MemberInfo {profile} memCategory memStatus = do
   currentTs <- liftIO getCurrentTime
-  (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memInfo currentTs
+  (localDisplayName, memProfileId) <- createNewMemberProfile_ db user profile currentTs
   let newMember =
         NewGroupMember
           { memInfo,
@@ -778,8 +873,8 @@ createNewGroupMember db user gInfo memInfo memCategory memStatus = do
           }
   liftIO $ createNewMember_ db user gInfo newMember currentTs
 
-createNewMemberProfile_ :: DB.Connection -> User -> MemberInfo -> UTCTime -> ExceptT StoreError IO (Text, ProfileId)
-createNewMemberProfile_ db User {userId} (MemberInfo _ _ _ Profile {displayName, fullName, image, contactLink, preferences}) createdAt =
+createNewMemberProfile_ :: DB.Connection -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId)
+createNewMemberProfile_ db User {userId} Profile {displayName, fullName, image, contactLink, preferences} createdAt =
   ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
     DB.execute
       db
@@ -955,7 +1050,7 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
       (localDisplayName, contactId, memProfileId) <- createContact_ db userId directConnId memberProfile "" (Just groupId) currentTs Nothing
       pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Just contactId, memProfileId}
     Nothing -> do
-      (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memInfo currentTs
+      (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
       pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Nothing, memProfileId}
   liftIO $ do
     member <- createNewMember_ db user gInfo newMember currentTs
@@ -1732,3 +1827,36 @@ createMemberContactConn_
     connId <- insertedRowId db
     setCommandConnId db user cmdId connId
     pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = False, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnJoined, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
+
+updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
+updateMemberProfile db User {userId} m p'
+  | displayName == newName = do
+    liftIO $ updateContactProfile_ db userId profileId p'
+    pure m {memberProfile = profile}
+  | otherwise =
+    ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
+      currentTs <- getCurrentTime
+      updateContactProfile_' db userId profileId p' currentTs
+      DB.execute
+        db
+        "UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?"
+        (ldn, currentTs, userId, groupMemberId)
+      DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
+      pure $ Right m {localDisplayName = ldn, memberProfile = profile}
+  where
+    GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
+    Profile {displayName = newName} = p'
+    profile = toLocalProfile profileId p' localAlias
+
+getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
+getXGrpLinkMemReceived db mId =
+  ExceptT . firstRow fromOnly (SEGroupMemberNotFound mId) $
+    DB.query db "SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ?" (Only mId)
+
+setXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> Bool -> IO ()
+setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do
+  currentTs <- getCurrentTime
+  DB.execute
+    db
+    "UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
+    (xGrpLinkMemReceived, currentTs, mId)

src/Simplex/Chat/Store/Migrations.hs

@@ -86,6 +86,7 @@ import Simplex.Chat.Migrations.M20231002_conn_initiated
 import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
 import Simplex.Chat.Migrations.M20231010_member_settings
 import Simplex.Chat.Migrations.M20231019_indexes
+import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -171,7 +172,8 @@ schemaMigrations =
     ("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated),
     ("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash),
     ("20231010_member_settings", m20231010_member_settings, Just down_m20231010_member_settings),
-    ("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes)
+    ("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes),
+    ("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received)
   ]
 
 -- | The list of migrations in ascending order by date