core: prepare and connect to group (#5964)

src/Simplex/Chat/Store/Groups.hs

@@ -33,6 +33,9 @@ module Simplex.Chat.Store.Groups
     createGroupInvitation,
     deleteContactCardKeepConn,
     createPreparedGroup,
+    setGroupConnLinkStartedConnection,
+    updatePreparedUserAndHostMembersInvited,
+    updatePreparedUserAndHostMembersRejected,
     createGroupInvitedViaLink,
     createGroupRejectedViaLink,
     setViaGroupLinkHash,
@@ -50,6 +53,7 @@ module Simplex.Chat.Store.Groups
     getActiveMembersByName,
     getGroupInfoByName,
     getGroupMember,
+    getHostMember,
     getMentionedGroupMember,
     getMentionedMemberByMemberId,
     getGroupMemberById,
@@ -156,6 +160,7 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
 import Data.Ord (Down (..))
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
+import Data.Text.Encoding (encodeUtf8)
 import Simplex.Chat.Messages
 import Simplex.Chat.Protocol (MsgMention (..), groupForwardVersion)
 import Simplex.Chat.Store.Direct
@@ -284,7 +289,8 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = do
             -- GroupInfo
             g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
             g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
-            g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
+            g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
+            g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
             g.business_chat, g.business_member_id, g.customer_member_id,
             g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
             -- GroupInfo {membership}
@@ -367,6 +373,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
           chatTs = Just currentTs,
           userMemberProfileSentAt = Just currentTs,
           connLinkToConnect = Nothing,
+          connLinkStartedConnection = False,
           chatTags = [],
           chatItemTTL = Nothing,
           uiThemes = Nothing,
@@ -439,6 +446,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
                   chatTs = Just currentTs,
                   userMemberProfileSentAt = Just currentTs,
                   connLinkToConnect = Nothing,
+                  connLinkStartedConnection = False,
                   chatTags = [],
                   chatItemTTL = Nothing,
                   uiThemes = Nothing,
@@ -537,22 +545,102 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {
   DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
 
 createPreparedGroup :: DB.Connection -> VersionRangeChat -> User -> GroupProfile -> ACreatedConnLink -> ExceptT StoreError IO GroupInfo
-createPreparedGroup db vr user@User {userId} groupProfile connLinkToConnect = do
+createPreparedGroup db vr user@User {userId, userContactId} groupProfile connLinkToConnect = do
   currentTs <- liftIO getCurrentTime
-  -- TODO [short links] support preparing business chats
-  let business = Nothing
-  groupId <- createGroup_ db userId groupProfile (Just connLinkToConnect) business currentTs
-  -- TODO [short links] create "unknown" host member here? set invitedByGroupMemberId later?
-  -- TODO  - same for invitedMember
-  -- TODO  - for membershipStatus - new status GSMemNew?
-  -- TODO  - customUserProfileId - pass on APIConnectPreparedGroup, update member; or separate apis for switching before joining?
-  let invitedByGroupMemberId = Nothing
-      invitedMember = MemberIdRole (MemberId "unknown") GRMember
-      membershipStatus = GSMemAccepted
-      customUserProfileId = Nothing
-  void $ createContactMemberInv_ db user groupId invitedByGroupMemberId user invitedMember GCUserMember membershipStatus IBUnknown customUserProfileId currentTs vr
-  -- TODO [short links] review: setViaGroupLinkHash
+  (groupId, groupLDN) <- createGroup_ db userId groupProfile (Just connLinkToConnect) Nothing currentTs
+  hostMemberId <- insertHost_ currentTs groupId groupLDN
+  let userMember = MemberIdRole (MemberId $ encodeUtf8 groupLDN <> "_user_unknown_id") GRMember
+  void $ createContactMemberInv_ db user groupId (Just hostMemberId) user userMember GCUserMember GSMemUnknown IBUnknown Nothing currentTs vr
   getGroupInfo db vr user groupId
+  where
+    insertHost_ currentTs groupId groupLDN = do
+      let memberId = MemberId $ encodeUtf8 groupLDN <> "_host_unknown_id"
+          hostProfile = profileFromName $ nameFromMemberId memberId
+      (localDisplayName, profileId) <- createNewMemberProfile_ db user hostProfile currentTs
+      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, GRAdmin, GCHostMember, GSMemAccepted, fromInvitedBy userContactId IBUnknown)
+              :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
+          )
+        insertedRowId db
+
+setGroupConnLinkStartedConnection :: DB.Connection -> GroupInfo -> Bool -> IO GroupInfo
+setGroupConnLinkStartedConnection db groupInfo@GroupInfo {groupId} connLinkStartedConnection = do
+  currentTs <- getCurrentTime
+  DB.execute
+    db
+    "UPDATE groups SET conn_link_started_connection = ?, updated_at = ? WHERE group_id = ?"
+    (BI connLinkStartedConnection, currentTs, groupId)
+  pure groupInfo {connLinkStartedConnection = connLinkStartedConnection}
+
+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} = do
+  let fromMemberProfile = profileFromName fromMemberName
+      initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted
+  updatePreparedUserAndHostMembers' db vr user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile 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
+  let fromMemberProfile = profileFromName $ nameFromMemberId memberId
+  updatePreparedUserAndHostMembers' db vr user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile GSMemRejected
+
+updatePreparedUserAndHostMembers' :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
+updatePreparedUserAndHostMembers'
+  db
+  vr
+  user
+  gInfo@GroupInfo {groupId, groupProfile = gp}
+  hostMember
+  fromMember
+  fromMemberProfile
+  invitedMember
+  groupProfile
+  membershipStatus = do
+    currentTs <- liftIO getCurrentTime
+    liftIO $ updateUserMember currentTs
+    hostMember' <- updateHostMember currentTs
+    when (gp /= groupProfile) $
+      void $ updateGroupProfile db user gInfo groupProfile
+    gInfo' <- getGroupInfo db vr user groupId
+    pure (gInfo', hostMember')
+    where
+      updateUserMember currentTs = do
+        let GroupInfo {membership} = gInfo
+            MemberIdRole memberId memberRole = invitedMember
+        DB.execute
+          db
+          [sql|
+            UPDATE group_members
+            SET member_id = ?,
+                member_role = ?,
+                member_status = ?,
+                updated_at = ?
+            WHERE group_member_id = ?
+          |]
+          (memberId, memberRole, membershipStatus, currentTs, groupMemberId' membership)
+      updateHostMember currentTs = do
+        _ <- updateMemberProfile db user hostMember fromMemberProfile
+        let MemberIdRole memberId memberRole = fromMember
+            gmId = groupMemberId' hostMember
+        liftIO $
+          DB.execute
+            db
+            [sql|
+              UPDATE group_members
+              SET member_id = ?,
+                  member_role = ?,
+                  updated_at = ?
+              WHERE group_member_id = ?
+            |]
+            (memberId, memberRole, currentTs, gmId)
+        getGroupMemberById db vr 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
@@ -578,7 +666,7 @@ createGroupViaLink'
   business
   membershipStatus = do
     currentTs <- liftIO getCurrentTime
-    groupId <- createGroup_ db userId groupProfile Nothing business currentTs
+    (groupId, _groupLDN) <- createGroup_ db userId groupProfile Nothing business 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
@@ -603,7 +691,7 @@ createGroupViaLink'
             )
           insertedRowId db
 
-createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe ACreatedConnLink -> Maybe BusinessChatInfo -> UTCTime -> ExceptT StoreError IO GroupId
+createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe ACreatedConnLink -> Maybe BusinessChatInfo -> UTCTime -> ExceptT StoreError IO (GroupId, Text)
 createGroup_ db userId groupProfile connLinkToConnect business currentTs = ExceptT $ do
   let GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} = groupProfile
   withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
@@ -623,7 +711,8 @@ createGroup_ db userId groupProfile connLinkToConnect business currentTs = Excep
           VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
         |]
         ((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. connLinkToConnectRow connLinkToConnect :. businessChatInfoRow business)
-      insertedRowId db
+      groupId <- insertedRowId db
+      pure (groupId, localDisplayName)
 
 setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO ()
 setViaGroupLinkHash db groupId connId =
@@ -800,7 +889,8 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
           SELECT
             g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
             g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
-            g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
+            g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
+            g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
             g.business_chat, g.business_member_id, g.customer_member_id,
             g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
             mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
@@ -893,6 +983,14 @@ getGroupMember db vr user@User {userId} groupId groupMemberId =
       (groupMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
       (userId, groupId, groupMemberId, userId)
 
+getHostMember :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO GroupMember
+getHostMember db vr user@User {userId} groupId =
+  ExceptT . firstRow (toContactMember vr user) (SEGroupHostMemberNotFound groupId) $
+    DB.query
+      db
+      (groupMemberQuery <> " WHERE m.group_id = ? AND m.member_category = ?")
+      (userId, groupId, GCHostMember)
+
 getMentionedGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO CIMention
 getMentionedGroupMember db User {userId} groupId gmId =
   ExceptT $
@@ -1660,7 +1758,8 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
             -- GroupInfo
             g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
             g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
-            g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect,
+            g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
+            g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
             g.business_chat, g.business_member_id, g.customer_member_id,
             g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
             -- GroupInfo {membership}