chat groups: establish connection between host and invitee members (#77)

* create group after invitation

* add group invitation to db, show sent and received group invitations

* test creating group and sending invitation

* establish group connections (WIP)

* connect user to the inviter, notification, member classification

src/Simplex/Chat/Store.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -25,9 +26,12 @@ module Simplex.Chat.Store
     getContactConnections,
     getConnectionChatDirection,
     createNewGroup,
-    createGroup,
+    createGroupInvitation,
     getGroup,
+    getGroupInvitation,
     createGroupMember,
+    createMemberConnection,
+    updateGroupMemberStatus,
   )
 where
 
@@ -42,7 +46,7 @@ import Data.ByteString.Char8 (ByteString)
 import Data.FileEmbed (embedDir, makeRelativeToProject)
 import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (sortBy)
+import Data.List (find, sortBy)
 import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -53,10 +57,10 @@ import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
-import Simplex.Messaging.Agent.Protocol (AParty (..), ConnId)
+import Simplex.Messaging.Agent.Protocol (AParty (..), ConnId, SMPQueueInfo)
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, withTransaction)
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
-import Simplex.Messaging.Util (bshow, liftIOEither, (<$$>))
+import Simplex.Messaging.Util (bshow, liftIOEither)
 import System.FilePath (takeBaseName, takeExtension)
 import UnliftIO.STM
 
@@ -83,7 +87,9 @@ handleSQLError err e
 insertedRowId :: DB.Connection -> IO Int64
 insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
 
-createUser :: (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> Profile -> Bool -> m User
+type StoreMonad m = (MonadUnliftIO m, MonadError StoreError m)
+
+createUser :: StoreMonad m => SQLiteStore -> Profile -> Bool -> m User
 createUser st Profile {displayName, fullName} activeUser =
   liftIOEither . checkConstraint SEDuplicateName . withTransaction st $ \db -> do
     DB.execute db "INSERT INTO users (local_display_name, active_user, contact_id) VALUES (?, ?, 0)" (displayName, activeUser)
@@ -131,8 +137,7 @@ createDirectConnection st userId agentConnId =
       |]
       (userId, agentConnId, ConnNew, ConnContact)
 
-createDirectContact ::
-  (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> UserId -> Connection -> Profile -> m ()
+createDirectContact :: StoreMonad m => SQLiteStore -> UserId -> Connection -> Profile -> m ()
 createDirectContact st userId Connection {connId} Profile {displayName, fullName} =
   liftIOEither . withTransaction st $ \db ->
     withLocalDisplayName db userId displayName $ \localDisplayName' -> do
@@ -174,7 +179,7 @@ deleteContact st userId displayName =
 -- TODO return the last connection that is ready, not any last connection
 -- requires updating connection status
 getContact ::
-  (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> UserId -> ContactName -> m Contact
+  StoreMonad m => SQLiteStore -> UserId -> ContactName -> m Contact
 getContact st userId localDisplayName =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
     c@Contact {contactId} <- getContact_ db
@@ -212,7 +217,7 @@ getContact st userId localDisplayName =
     connection (connRow : _) = Right $ toConnection connRow
     connection _ = Left $ SEContactNotReady localDisplayName
 
-getContactConnections :: (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> UserId -> ContactName -> m [Connection]
+getContactConnections :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m [Connection]
 getContactConnections st userId displayName =
   liftIOEither . withTransaction st $ \db ->
     connections
@@ -234,6 +239,8 @@ getContactConnections st userId displayName =
 
 type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, UTCTime)
 
+type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe UTCTime)
+
 toConnection :: ConnectionRow -> Connection
 toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, createdAt) =
   let entityId = entityId_ connType
@@ -243,20 +250,27 @@ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType,
     entityId_ ConnContact = contactId
     entityId_ ConnMember = groupMemberId
 
-getConnectionChatDirection ::
-  (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> UserId -> ConnId -> m (ChatDirection 'Agent)
-getConnectionChatDirection st userId agentConnId =
-  liftIOEither . withTransaction st $ \db -> do
-    getConnection_ db >>= \case
-      Left e -> pure $ Left e
-      Right c@Connection {connType, entityId} -> case connType of
-        ConnMember -> pure . Left $ SEInternal "group members not supported yet"
-        ConnContact ->
-          ReceivedDirectMessage <$$> case entityId of
-            Nothing -> pure . Right $ CConnection c
-            Just cId -> getContact_ db cId c
+toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
+toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, Just createdAt) =
+  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, createdAt)
+toMaybeConnection _ = Nothing
+
+getConnectionChatDirection :: StoreMonad m => SQLiteStore -> User -> ConnId -> m (ChatDirection 'Agent)
+getConnectionChatDirection st User {userId, userContactId} agentConnId =
+  liftIOEither . withTransaction st $ \db -> runExceptT $ do
+    c@Connection {connType, entityId} <- getConnection_ db
+    case connType of
+      ConnMember ->
+        case entityId of
+          Nothing -> throwError $ SEInternal "group member without connection"
+          Just groupMemberId -> uncurry ReceivedGroupMessage <$> getGroupAndMember_ db groupMemberId
+      ConnContact ->
+        ReceivedDirectMessage <$> case entityId of
+          Nothing -> pure $ CConnection c
+          Just contactId -> getContact_ db contactId c
   where
-    getConnection_ db =
+    getConnection_ :: DB.Connection -> ExceptT StoreError IO Connection
+    getConnection_ db = ExceptT $ do
       connection
         <$> DB.query
           db
@@ -267,9 +281,11 @@ getConnectionChatDirection st userId agentConnId =
             WHERE user_id = ? AND agent_conn_id = ?
           |]
           (userId, agentConnId)
+    connection :: [ConnectionRow] -> Either StoreError Connection
     connection (connRow : _) = Right $ toConnection connRow
     connection _ = Left $ SEConnectionNotFound agentConnId
-    getContact_ db contactId c =
+    getContact_ :: DB.Connection -> Int64 -> Connection -> ExceptT StoreError IO ConnContact
+    getContact_ db contactId c = ExceptT $ do
       toContact contactId c
         <$> DB.query
           db
@@ -280,96 +296,94 @@ getConnectionChatDirection st userId agentConnId =
             WHERE c.user_id = ? AND c.contact_id = ?
           |]
           (userId, contactId)
+    toContact :: Int64 -> Connection -> [(ContactName, Text, Text)] -> Either StoreError ConnContact
     toContact contactId c [(localDisplayName, displayName, fullName)] =
       let profile = Profile {displayName, fullName}
        in Right $ CContact Contact {contactId, localDisplayName, profile, activeConn = c}
     toContact _ _ _ = Left $ SEInternal "referenced contact not found"
+    getGroupAndMember_ :: DB.Connection -> Int64 -> ExceptT StoreError IO (GroupName, GroupMember)
+    getGroupAndMember_ db groupMemberId = ExceptT $ do
+      toGroupAndMember
+        <$> DB.query
+          db
+          [sql|
+            SELECT
+              g.local_display_name,
+              m.group_member_id, m.member_id, m.member_role, m.member_status,
+              m.invited_by, m.contact_id, p.display_name, p.full_name
+            FROM group_members m
+            JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
+            JOIN groups g ON g.group_id = m.group_id
+            WHERE m.group_member_id = ?
+          |]
+          (Only groupMemberId)
+    toGroupAndMember :: [Only GroupName :. GroupMemberRow] -> Either StoreError (GroupName, GroupMember)
+    toGroupAndMember [Only groupName :. memberRow] = Right (groupName, toGroupMember userContactId memberRow)
+    toGroupAndMember _ = Left $ SEInternal "referenced group member not found"
 
 -- | creates completely new group with a single member - the current user
-createNewGroup :: (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> TVar ChaChaDRG -> User -> GroupProfile -> m Group
-createNewGroup st gVar User {userId, userContactId, profile} p@GroupProfile {displayName, fullName} =
+createNewGroup :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> GroupProfile -> m Group
+createNewGroup st gVar user groupProfile =
   liftIOEither . checkConstraint SEDuplicateName . withTransaction st $ \db -> do
-    DB.execute db "INSERT INTO display_names (local_display_name, ldn_base, user_id) VALUES (?, ?, ?)" (displayName, displayName, userId)
+    let GroupProfile {displayName, fullName} = groupProfile
+        uId = userId user
+    DB.execute db "INSERT INTO display_names (local_display_name, ldn_base, user_id) VALUES (?, ?, ?)" (displayName, displayName, uId)
     DB.execute db "INSERT INTO group_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
     profileId <- insertedRowId db
-    DB.execute db "INSERT INTO groups (local_display_name, user_id, group_profile_id) VALUES (?, ?, ?)" (displayName, userId, profileId)
+    DB.execute db "INSERT INTO groups (local_display_name, user_id, group_profile_id) VALUES (?, ?, ?)" (displayName, uId, profileId)
     groupId <- insertedRowId db
     memberId <- randomId gVar 12
-    createMember_ db groupId userContactId GROwner GSMemReady (Just userContactId) memberId
-    groupMemberId <- insertedRowId db
-    let membership =
-          GroupMember
-            { groupMemberId,
-              memberId,
-              memberRole = GROwner,
-              memberStatus = GSMemReady,
-              invitedBy = IBUser,
-              memberProfile = profile,
-              memberContactId = Just userContactId
-            }
-    pure $ Right Group {groupId, localDisplayName = displayName, groupProfile = p, members = [], membership}
+    membership <- createContactMember_ db user groupId user (memberId, GROwner) GSMemFull IBUser
+    pure $ Right Group {groupId, localDisplayName = displayName, groupProfile, members = [], membership}
 
 -- | creates a new group record for the group the current user was invited to
-createGroup :: (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> TVar ChaChaDRG -> User -> Contact -> GroupProfile -> m Group
-createGroup st gVar User {userId, userContactId, profile} contact p@GroupProfile {displayName, fullName} =
-  liftIOEither . withTransaction st $ \db ->
-    withLocalDisplayName db userId displayName $ \localDisplayName -> do
+createGroupInvitation ::
+  StoreMonad m => SQLiteStore -> User -> Contact -> GroupInvitation -> m Group
+createGroupInvitation st user contact GroupInvitation {fromMember, invitedMember, queueInfo, groupProfile} =
+  liftIOEither . withTransaction st $ \db -> do
+    let GroupProfile {displayName, fullName} = groupProfile
+        uId = userId user
+    withLocalDisplayName db uId displayName $ \localDisplayName -> do
       DB.execute db "INSERT INTO group_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
       profileId <- insertedRowId db
-      DB.execute
-        db
-        [sql|
-          INSERT INTO groups
-            (group_profile_id, local_display_name, user_id) VALUES (?, ?, ?)
-        |]
-        (profileId, localDisplayName, userId)
+      DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, queueInfo, uId)
       groupId <- insertedRowId db
-      pure Group {groupId, localDisplayName, groupProfile = p, members = undefined, membership = undefined}
-
--- where
--- createMember_ db groupId userContactId GROwner GSMemReady (Just userContactId) memberId
--- groupMemberId <- insertedRowId db
--- let membership =
---       GroupMember
---         { groupMemberId,
---           memberId,
---           memberRole = GROwner,
---           memberStatus = GSMemReady,
---           invitedBy = IBUser,
---           memberProfile = profile,
---           memberContactId = Just userContactId
---         }
--- pure $ Right Group {groupId, localDisplayName = displayName, groupProfile = p, members = [], membership}
+      member <- createContactMember_ db user groupId contact fromMember GSMemFull IBUnknown
+      membership <- createContactMember_ db user groupId user invitedMember GSMemInvited (IBContact $ contactId contact)
+      pure Group {groupId, localDisplayName, groupProfile, members = [(member, Nothing)], membership}
 
 -- TODO return the last connection that is ready, not any last connection
 -- requires updating connection status
-getGroup :: (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> User -> GroupName -> m Group
-getGroup st User {userId, userContactId} localDisplayName =
-  liftIOEither . withTransaction st $ \db -> runExceptT $ do
-    g@Group {groupId} <- getGroup_ db
-    members <- getMembers_ db groupId
-    membership <- getUserMember_ db groupId
-    pure g {members, membership}
+getGroup :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Group
+getGroup st user localDisplayName =
+  liftIOEither . withTransaction st $ \db -> runExceptT $ fst <$> getGroup_ db user localDisplayName
+
+getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO (Group, Maybe SMPQueueInfo)
+getGroup_ db User {userId, userContactId} localDisplayName = do
+  (g@Group {groupId}, qInfo) <- getGroupRec_
+  allMembers <- getMembers_ groupId
+  (members, membership) <- liftEither $ splitUserMember_ allMembers
+  pure (g {members, membership}, qInfo)
   where
-    getGroup_ :: DB.Connection -> ExceptT StoreError IO Group
-    getGroup_ db = ExceptT $ do
+    getGroupRec_ :: ExceptT StoreError IO (Group, Maybe SMPQueueInfo)
+    getGroupRec_ = ExceptT $ do
       toGroup
         <$> DB.query
           db
           [sql|
-            SELECT g.group_id, p.display_name, p.full_name
+            SELECT g.group_id, p.display_name, p.full_name, g.inv_queue_info
             FROM groups g
             JOIN group_profiles p ON p.group_profile_id = g.group_profile_id
             WHERE g.local_display_name = ? AND g.user_id = ?
           |]
           (localDisplayName, userId)
-    toGroup :: [(Int64, GroupName, Text)] -> Either StoreError Group
-    toGroup [(groupId, displayName, fullName)] =
+    toGroup :: [(Int64, GroupName, Text, Maybe SMPQueueInfo)] -> Either StoreError (Group, Maybe SMPQueueInfo)
+    toGroup [(groupId, displayName, fullName, qInfo)] =
       let groupProfile = GroupProfile {displayName, fullName}
-       in Right Group {groupId, localDisplayName, groupProfile, members = undefined, membership = undefined}
+       in Right (Group {groupId, localDisplayName, groupProfile, members = undefined, membership = undefined}, qInfo)
     toGroup _ = Left $ SEGroupNotFound localDisplayName
-    getMembers_ :: DB.Connection -> Int64 -> ExceptT StoreError IO [(GroupMember, Connection)]
-    getMembers_ db groupId = ExceptT $ do
+    getMembers_ :: Int64 -> ExceptT StoreError IO [(GroupMember, Maybe Connection)]
+    getMembers_ groupId = ExceptT $ do
       Right . map toContactMember
         <$> DB.query
           db
@@ -380,81 +394,99 @@ getGroup st User {userId, userContactId} localDisplayName =
               c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
               c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
             FROM group_members m
-            JOIN groups g ON g.group_id = m.group_id
             JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
-            JOIN connections c ON c.group_member_id = m.group_member_id
-            WHERE g.group_id = ?
-            ORDER BY c.connection_id DESC
-            LIMIT 1
+            LEFT JOIN connections c ON c.connection_id = (
+              SELECT max(cc.connection_id)
+              FROM connections cc
+              where cc.group_member_id = c.group_member_id
+            )
+            WHERE m.group_id = ?
           |]
           (Only groupId)
-    getUserMember_ :: DB.Connection -> Int64 -> ExceptT StoreError IO GroupMember
-    getUserMember_ db groupId = ExceptT $ do
-      userMember
-        <$> DB.query
-          db
-          [sql|
-            SELECT
-              m.group_member_id, m.member_id, m.member_role, m.member_status,
-              m.invited_by, m.contact_id, p.display_name, p.full_name
-            FROM group_members m
-            JOIN groups g ON g.group_id = m.group_id
-            JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
-            WHERE g.group_id = ? AND m.contact_id = ?
-          |]
-          (groupId, userContactId)
-    toContactMember :: (GroupMemberRow :. ConnectionRow) -> (GroupMember, Connection)
-    toContactMember (memberRow :. connRow) = (toGroupMember memberRow, toConnection connRow)
-    toGroupMember :: GroupMemberRow -> GroupMember
-    toGroupMember (groupMemberId, memberId, memberRole, memberStatus, invitedById, memberContactId, displayName, fullName) =
-      let memberProfile = Profile {displayName, fullName}
-          invitedBy = toInvitedBy userContactId invitedById
-       in GroupMember {groupMemberId, memberId, memberRole, memberStatus, invitedBy, memberProfile, memberContactId}
-    userMember :: [GroupMemberRow] -> Either StoreError GroupMember
-    userMember [memberRow] = Right $ toGroupMember memberRow
-    userMember _ = Left SEGroupWithoutUser
+    toContactMember :: (GroupMemberRow :. MaybeConnectionRow) -> (GroupMember, Maybe Connection)
+    toContactMember (memberRow :. connRow) = (toGroupMember userContactId memberRow, toMaybeConnection connRow)
+    splitUserMember_ :: [(GroupMember, Maybe Connection)] -> Either StoreError ([(GroupMember, Maybe Connection)], GroupMember)
+    splitUserMember_ allMembers =
+      let (b, a) = break ((== Just userContactId) . memberContactId . fst) allMembers
+       in case a of
+            [] -> Left SEGroupWithoutUser
+            u : ms -> Right (b <> ms, fst u)
+
+getGroupInvitation :: StoreMonad m => SQLiteStore -> User -> GroupName -> m ReceivedGroupInvitation
+getGroupInvitation st user localDisplayName =
+  liftIOEither . withTransaction st $ \db -> runExceptT $ do
+    (Group {membership, members, groupProfile}, qInfo) <- getGroup_ db user localDisplayName
+    when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined
+    case (qInfo, findFromContact (invitedBy membership) members) of
+      (Just queueInfo, Just (fromMember, Nothing)) ->
+        pure ReceivedGroupInvitation {fromMember, invitedMember = membership, queueInfo, groupProfile}
+      _ -> throwError SENoGroupInvitation
+  where
+    findFromContact :: InvitedBy -> [(GroupMember, Maybe Connection)] -> Maybe (GroupMember, Maybe Connection)
+    findFromContact (IBContact contactId) = find (\(m, _) -> memberContactId m == Just contactId)
+    findFromContact _ = const Nothing
 
 type GroupMemberRow = (Int64, ByteString, GroupMemberRole, GroupMemberStatus, Maybe Int64, Maybe Int64, ContactName, Text)
 
-createGroupMember :: (MonadUnliftIO m, MonadError StoreError m) => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Int64 -> GroupMemberRole -> InvitedBy -> ConnId -> m MemberId
-createGroupMember st gVar User {userId, userContactId} groupId contactId memberRole invitedBy agentConnId =
-  liftIOEither . withTransaction st $ \db -> do
-    let invitedById = fromInvitedBy userContactId invitedBy
-    memberId <- createWithRandomId gVar $ createMember_ db groupId contactId memberRole GSMemInvited invitedById
-    groupMemberId <- insertedRowId db
-    liftIO $ createMemberConnection_ db groupMemberId
-    pure memberId
-  where
-    createMemberConnection_ :: DB.Connection -> Int64 -> IO ()
-    createMemberConnection_ db groupMemberId =
-      DB.execute
-        db
-        [sql|
-          INSERT INTO connections
-            (user_id, agent_conn_id, conn_status, conn_type, group_member_id) VALUES (?,?,?,?,?);
-        |]
-        (userId, agentConnId, ConnNew, ConnMember, groupMemberId)
+toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
+toGroupMember userContactId (groupMemberId, memberId, memberRole, memberStatus, invitedById, memberContactId, displayName, fullName) =
+  let memberProfile = Profile {displayName, fullName}
+      invitedBy = toInvitedBy userContactId invitedById
+   in GroupMember {groupMemberId, memberId, memberRole, memberStatus, invitedBy, memberProfile, memberContactId}
 
-createMember_ :: DB.Connection -> Int64 -> Int64 -> GroupMemberRole -> GroupMemberStatus -> Maybe Int64 -> ByteString -> IO ()
-createMember_ db groupId contactId memberRole memberStatus invitedBy memberId =
-  DB.executeNamed
+createGroupMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> m GroupMember
+createGroupMember st gVar user groupId contact memberRole agentConnId =
+  liftIOEither . withTransaction st $ \db ->
+    createWithRandomId gVar $ \memId -> do
+      member <- createContactMember_ db user groupId contact (memId, memberRole) GSMemInvited IBUser
+      groupMemberId <- insertedRowId db
+      createMemberConnection_ db (userId user) groupMemberId agentConnId
+      pure member
+
+createMemberConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> m ()
+createMemberConnection st userId groupMemberId agentConnId =
+  liftIO . withTransaction st $ \db -> createMemberConnection_ db userId groupMemberId agentConnId
+
+updateGroupMemberStatus :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> GroupMemberStatus -> m ()
+updateGroupMemberStatus _st _userId _groupMemberId _memberStatus = pure ()
+
+createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> IO ()
+createMemberConnection_ db userId groupMemberId agentConnId =
+  DB.execute
     db
     [sql|
-      INSERT INTO group_members
-        ( group_id, member_id, member_role, member_status, invited_by,
-          contact_profile_id, contact_id)
-      VALUES
-        (:group_id,:member_id,:member_role,:member_status,:invited_by,
-          (SELECT contact_profile_id FROM contacts WHERE contact_id = :contact_id),
-          :contact_id)
+      INSERT INTO connections
+        (user_id, agent_conn_id, conn_status, conn_type, group_member_id) VALUES (?,?,?,?,?);
     |]
-    [ ":group_id" := groupId,
-      ":member_id" := memberId,
-      ":member_role" := memberRole,
-      ":member_status" := memberStatus,
-      ":invited_by" := invitedBy,
-      ":contact_id" := contactId
-    ]
+    (userId, agentConnId, ConnNew, ConnMember, groupMemberId)
+
+createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> MemberInfo -> GroupMemberStatus -> InvitedBy -> IO GroupMember
+createContactMember_ db User {userContactId} groupId userOrContact (memberId, memberRole) memberStatus invitedBy = do
+  insertMember_
+  groupMemberId <- insertedRowId db
+  let memberProfile = profile' userOrContact
+      memberContactId = Just $ contactId' userOrContact
+  pure GroupMember {groupMemberId, memberId, memberRole, memberStatus, invitedBy, memberProfile, memberContactId}
+  where
+    insertMember_ =
+      DB.executeNamed
+        db
+        [sql|
+          INSERT INTO group_members
+            ( group_id, member_id, member_role, member_status, invited_by,
+              contact_profile_id, contact_id)
+          VALUES
+            (:group_id,:member_id,:member_role,:member_status,:invited_by,
+              (SELECT contact_profile_id FROM contacts WHERE contact_id = :contact_id),
+              :contact_id)
+        |]
+        [ ":group_id" := groupId,
+          ":member_id" := memberId,
+          ":member_role" := memberRole,
+          ":member_status" := memberStatus,
+          ":invited_by" := fromInvitedBy userContactId invitedBy,
+          ":contact_id" := contactId' userOrContact
+        ]
 
 -- | Saves unique local display name based on passed displayName, suffixed with _N if required.
 -- This function should be called inside transaction.
@@ -492,15 +524,15 @@ withLocalDisplayName db userId displayName action = getLdnSuffix >>= (`tryCreate
             |]
             (ldn, displayName, ldnSuffix, userId)
 
-createWithRandomId :: TVar ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
+createWithRandomId :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> IO (Either StoreError a)
 createWithRandomId gVar create = tryCreate 3
   where
-    tryCreate :: Int -> IO (Either StoreError ByteString)
+    tryCreate :: Int -> IO (Either StoreError a)
     tryCreate 0 = pure $ Left SEUniqueID
     tryCreate n = do
       id' <- randomId gVar 12
       E.try (create id') >>= \case
-        Right _ -> pure $ Right id'
+        Right x -> pure $ Right x
         Left e
           | DB.sqlError e == DB.ErrorConstraint -> tryCreate (n - 1)
           | otherwise -> pure . Left . SEInternal $ bshow e
@@ -515,6 +547,8 @@ data StoreError
   | SEGroupNotFound GroupName
   | SEGroupWithoutUser
   | SEDuplicateGroupMember
+  | SEGroupAlreadyJoined
+  | SENoGroupInvitation
   | SEConnectionNotFound ConnId
   | SEUniqueID
   | SEInternal ByteString