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

migrations/20210612_initial.sql

@@ -61,6 +61,7 @@ CREATE TABLE groups (
   user_id INTEGER NOT NULL REFERENCES users,
   local_display_name TEXT NOT NULL, -- local group name without spaces
   group_profile_id INTEGER REFERENCES group_profiles, -- shared group profile
+  inv_queue_info BLOB,
   FOREIGN KEY (user_id, local_display_name)
     REFERENCES display_names (user_id, local_display_name)
     ON DELETE RESTRICT,
@@ -72,8 +73,8 @@ CREATE TABLE group_members ( -- group members, excluding the local user
   group_member_id INTEGER PRIMARY KEY,
   group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT,
   member_id BLOB NOT NULL, -- shared member ID, unique per group
-  member_role TEXT NOT NULL DEFAULT '', -- owner, admin, member
-  member_status TEXT NOT NULL DEFAULT '', -- new, invited, accepted, connected, ready
+  member_role TEXT NOT NULL, -- owner, admin, member
+  member_status TEXT NOT NULL, -- new, invited, accepted, connected, ready
   invited_by INTEGER REFERENCES contacts (contact_id) ON DELETE RESTRICT, -- NULL for the members who joined before the current user and for the group creator
   contact_profile_id INTEGER NOT NULL REFERENCES contact_profiles ON DELETE RESTRICT,
   contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,

package.yaml

@@ -18,6 +18,7 @@ dependencies:
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
+  - composition == 1.0.*
   - containers == 0.6.*
   - cryptonite >= 0.27 && < 0.30
   - directory == 1.3.*

src/Simplex/Chat.hs

@@ -23,7 +23,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.List (find)
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -59,6 +59,7 @@ data ChatCommand
   | SendMessage ContactName ByteString
   | NewGroup GroupProfile
   | AddMember GroupName ContactName GroupMemberRole
+  | JoinGroup GroupName
   | RemoveMember GroupName ContactName
   | MemberRole GroupName ContactName GroupMemberRole
   | LeaveGroup GroupName
@@ -138,40 +139,43 @@ processChatCommand user@User {userId, profile} = \case
     withStore $ \st -> createDirectConnection st userId connId
     showInvitation qInfo
   Connect qInfo -> do
-    connId <- withAgent $ \a -> joinConnection a qInfo $ encodeProfile profile
+    connId <- withAgent $ \a -> joinConnection a qInfo . directMessage $ XInfo profile
     withStore $ \st -> createDirectConnection st userId connId
-  DeleteContact cRef -> do
-    conns <- withStore $ \st -> getContactConnections st userId cRef
+  DeleteContact cName -> do
+    conns <- withStore $ \st -> getContactConnections st userId cName
     withAgent $ \a -> forM_ conns $ \Connection {agentConnId} ->
       deleteConnection a agentConnId `catchError` \(_ :: AgentErrorType) -> pure ()
-    withStore $ \st -> deleteContact st userId cRef
-    unsetActive $ ActiveC cRef
-    showContactDeleted cRef
-  SendMessage cRef msg -> do
-    contact <- withStore $ \st -> getContact st userId cRef
-    let body = MsgBodyContent {contentType = SimplexContentType XCText, contentData = msg}
-        rawMsg = rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent = XMsgNew MTText [] [body], chatDAG = Nothing}
-        connId = contactConnId contact
-    void . withAgent $ \a -> sendMessage a connId $ serializeRawChatMessage rawMsg
-    setActive $ ActiveC cRef
+    withStore $ \st -> deleteContact st userId cName
+    unsetActive $ ActiveC cName
+    showContactDeleted cName
+  SendMessage cName msg -> do
+    contact <- withStore $ \st -> getContact st userId cName
+    let msgEvent = XMsgNew MTText [] [MsgBodyContent {contentType = SimplexContentType XCText, contentData = msg}]
+    sendDirectMessage (contactConnId contact) msgEvent
+    setActive $ ActiveC cName
   NewGroup gProfile -> do
     gVar <- asks idsDrg
-    void $ withStore $ \st -> createNewGroup st gVar user gProfile
-    showGroupCreated gProfile
-  AddMember gRef cRef memRole -> do
-    (group, contact) <- withStore $ \st -> (,) <$> getGroup st user gRef <*> getContact st userId cRef
+    group <- withStore $ \st -> createNewGroup st gVar user gProfile
+    showGroupCreated group
+  AddMember gName cName memRole -> do
+    (group, contact) <- withStore $ \st -> (,) <$> getGroup st user gName <*> getContact st userId cName
     let Group {groupId, groupProfile, membership, members} = group
         userRole = memberRole membership
         userMemberId = memberId membership
     when (userRole < GRAdmin || userRole < memRole) $ throwError $ ChatError CEGroupRole
-    when (isMember contact members) $ throwError $ ChatError CEGroupDuplicateMember
+    when (isMember contact members) . throwError . ChatError $ CEGroupDuplicateMember cName
+    when (memberStatus membership == GSMemInvited) . throwError . ChatError $ CEGroupNotJoined gName
+    when (memberStatus membership < GSMemReady) . throwError . ChatError $ CEGroupMemberNotReady
     gVar <- asks idsDrg
     (agentConnId, qInfo) <- withAgent createConnection
-    memberId <- withStore $ \st -> createGroupMember st gVar user groupId (contactId contact) memRole IBUser agentConnId
-    let chatMsgEvent = XGrpInv (userMemberId, userRole) (memberId, memRole) qInfo groupProfile
-        rawMsg = rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent, chatDAG = Nothing}
-        connId = contactConnId contact
-    void . withAgent $ \a -> sendMessage a connId $ serializeRawChatMessage rawMsg
+    GroupMember {memberId} <- withStore $ \st -> createGroupMember st gVar user groupId contact memRole agentConnId
+    let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) qInfo groupProfile
+    sendDirectMessage (contactConnId contact) msg
+    showSentGroupInvitation group cName
+  JoinGroup gName -> do
+    ReceivedGroupInvitation {fromMember, invitedMember, queueInfo} <- withStore $ \st -> getGroupInvitation st user gName
+    agentConnId <- withAgent $ \a -> joinConnection a queueInfo . directMessage . XGrpAcpt $ memberId invitedMember
+    withStore $ \st -> createMemberConnection st userId (groupMemberId fromMember) agentConnId
   MemberRole _gRef _cRef _mRole -> pure ()
   RemoveMember _gRef _cRef -> pure ()
   LeaveGroup _gRef -> pure ()
@@ -179,7 +183,7 @@ processChatCommand user@User {userId, profile} = \case
   ListMembers _gRef -> pure ()
   SendGroupMessage _gRef _msg -> pure ()
   where
-    isMember :: Contact -> [(GroupMember, Connection)] -> Bool
+    isMember :: Contact -> [(GroupMember, Maybe Connection)] -> Bool
     isMember Contact {contactId} members = isJust $ find ((== Just contactId) . memberContactId . fst) members
 
 agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
@@ -192,8 +196,8 @@ agentSubscriber = do
     void . runExceptT $ processAgentMessage user connId msg `catchError` (liftIO . print)
 
 processAgentMessage :: forall m. ChatMonad m => User -> ConnId -> ACommand 'Agent -> m ()
-processAgentMessage User {userId, profile} agentConnId agentMessage = do
-  chatDirection <- withStore $ \st -> getConnectionChatDirection st userId agentConnId
+processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
+  chatDirection <- withStore $ \st -> getConnectionChatDirection st user agentConnId
   case chatDirection of
     ReceivedDirectMessage (CContact ct@Contact {localDisplayName = c}) ->
       case agentMessage of
@@ -202,11 +206,11 @@ processAgentMessage User {userId, profile} agentConnId agentMessage = do
           case chatMsgEvent of
             XMsgNew MTText [] body -> newTextMessage c meta $ find (isSimplexContentType XCText) body
             XInfo _ -> pure () -- TODO profile update
-            XGrpInv fromMem invMem qInfo groupProfile -> groupInvitation ct fromMem invMem qInfo groupProfile
+            XGrpInv gInv -> saveGroupInvitation ct gInv
             _ -> pure ()
         CON -> do
           -- TODO update connection status
-          showContactConnected c
+          showContactConnected ct
           showToast ("@" <> c) "connected"
           setActive $ ActiveC c
         END -> do
@@ -219,11 +223,52 @@ processAgentMessage User {userId, profile} agentConnId agentMessage = do
         CONF confId connInfo -> do
           -- TODO update connection status
           saveConnInfo conn connInfo
-          withAgent $ \a -> allowConnection a agentConnId confId $ encodeProfile profile
+          withAgent $ \a -> allowConnection a agentConnId confId . directMessage $ XInfo profile
         INFO connInfo ->
           saveConnInfo conn connInfo
         _ -> pure ()
-    _ -> pure ()
+    ReceivedGroupMessage gName m ->
+      case agentMessage of
+        CONF confId connInfo -> do
+          ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
+          case chatMsgEvent of
+            XGrpAcpt memId
+              | memId == memberId m -> do
+                withStore $ \st -> updateGroupMemberStatus st userId (groupMemberId m) GSMemAccepted
+                withAgent $ \a -> allowConnection a agentConnId confId ""
+              | otherwise -> pure () -- TODO error not matching member ID
+            _ -> pure () -- TODO show/log error, other events in SMP confirmation
+        CON -> do
+          Group {membership, members} <- withStore $ \st -> getGroup st user gName
+          -- TODO because the contact is not created instantly, if the member is not created from contact,
+          -- it should still have a unique local display name.
+          -- If it is created from contact it can still be duplicated on the member (and match the contact)
+          case invitedBy m of
+            IBUser -> do
+              -- sender was invited by the current user
+              withStore $ \st -> updateGroupMemberStatus st userId (groupMemberId m) GSMemConnected
+              sendGroupMessage members $ XGrpMemNew (memberId m) (memberRole m) (memberProfile m)
+              showConnectedGroupMember gName $ displayName (memberProfile m :: Profile)
+              forM_ (filter (\m' -> memberStatus m' >= GSMemConnected) . map fst $ members) $ \m' ->
+                sendDirectMessage agentConnId $ XGrpMemIntro (memberId m') (memberRole m') (memberProfile m')
+            _ -> do
+              if Just (invitedBy membership) == (IBContact <$> memberContactId m)
+                then do
+                  -- sender invited the current user
+                  withStore $ \st -> updateGroupMemberStatus st userId (groupMemberId m) GSMemConnected
+                  showUserConnectedToGroup gName
+                  pure ()
+                else do
+                  showConnectedGroupMember gName $ displayName (memberProfile m :: Profile)
+        MSG meta msgBody -> do
+          ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
+          case chatMsgEvent of
+            XGrpMemNew memId memRole memProfile -> do
+              Group {membership, members} <- withStore $ \st -> getGroup st user gName
+              when (memberId membership /= memId && isNothing (find ((== memId) . memberId . fst) members)) $
+                withStore $ \st -> pure () -- add new member as GSMemAccepted
+            _ -> pure ()
+        _ -> pure ()
   where
     newTextMessage :: ContactName -> MsgMeta -> Maybe MsgBodyContent -> m ()
     newTextMessage c meta = \case
@@ -234,10 +279,12 @@ processAgentMessage User {userId, profile} agentConnId agentMessage = do
         setActive $ ActiveC c
       _ -> pure ()
 
-    groupInvitation :: Contact -> (MemberId, GroupMemberRole) -> (MemberId, GroupMemberRole) -> SMPQueueInfo -> GroupProfile -> m ()
-    groupInvitation _ct (fromMemId, fromRole) (memId, memRole) _qInfo _groupProfile = do
+    saveGroupInvitation :: Contact -> GroupInvitation -> m ()
+    saveGroupInvitation ct@Contact {localDisplayName} inv@(GroupInvitation (fromMemId, fromRole) (memId, memRole) _ _) = do
       when (fromRole < GRAdmin || fromRole < memRole) $ throwError $ ChatError CEGroupRole
-      when (fromMemId == memId) $ throwError $ ChatError CEGroupDuplicateMember
+      when (fromMemId == memId) $ throwError $ ChatError CEGroupDuplicateMemberId
+      group <- withStore $ \st -> createGroupInvitation st user ct inv
+      showReceivedGroupInvitation group localDisplayName
 
     parseChatMessage :: ByteString -> Either ChatError ChatMessage
     parseChatMessage msgBody = first ChatErrorMessage (parseAll rawChatMessageP msgBody >>= toChatMessage)
@@ -250,10 +297,17 @@ processAgentMessage User {userId, profile} agentConnId agentMessage = do
           withStore $ \st -> createDirectContact st userId activeConn p
         _ -> pure () -- TODO show/log error, other events in SMP confirmation
 
-encodeProfile :: Profile -> ByteString
-encodeProfile profile =
-  let chatMsg = ChatMessage {chatMsgId = Nothing, chatMsgEvent = XInfo profile, chatDAG = Nothing}
-   in serializeRawChatMessage $ rawChatMessage chatMsg
+sendDirectMessage :: ChatMonad m => ConnId -> ChatMsgEvent -> m ()
+sendDirectMessage agentConnId chatMsgEvent =
+  void . withAgent $ \a -> sendMessage a agentConnId $ directMessage chatMsgEvent
+
+directMessage :: ChatMsgEvent -> ByteString
+directMessage chatMsgEvent =
+  serializeRawChatMessage $
+    rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent, chatDAG = Nothing}
+
+sendGroupMessage :: ChatMonad m => [(GroupMember, Maybe Connection)] -> ChatMsgEvent -> m ()
+sendGroupMessage _members _chatMsgEvent = pure ()
 
 getCreateActiveUser :: SQLiteStore -> IO User
 getCreateActiveUser st = do
@@ -341,6 +395,7 @@ chatCommandP =
   ("/help" <|> "/h") $> ChatHelp
     <|> ("/group #" <|> "/g #") *> (NewGroup <$> groupProfile)
     <|> ("/add #" <|> "/a #") *> (AddMember <$> displayName <* A.space <*> displayName <*> memberRole)
+    <|> ("/join #" <|> "/j #") *> (JoinGroup <$> displayName)
     <|> ("/remove #" <|> "/rm #") *> (RemoveMember <$> displayName <* A.space <*> displayName)
     <|> ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName)
     <|> ("/members #" <|> "/ms #") *> (ListMembers <$> displayName)
@@ -354,9 +409,9 @@ chatCommandP =
     displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' '))
     refChar c = c > ' ' && c /= '#' && c /= '@'
     groupProfile = do
-      gRef <- displayName
-      gName <- safeDecodeUtf8 <$> (A.space *> A.takeByteString) <|> pure ""
-      pure GroupProfile {displayName = gRef, fullName = if T.null gName then gRef else gName}
+      gName <- displayName
+      fullName' <- safeDecodeUtf8 <$> (A.space *> A.takeByteString) <|> pure ""
+      pure GroupProfile {displayName = gName, fullName = if T.null fullName' then gName else fullName'}
     memberRole =
       (" owner" $> GROwner)
         <|> (" admin" $> GRAdmin)

src/Simplex/Chat/Controller.hs

@@ -40,7 +40,14 @@ data ChatError
   | ChatErrorStore StoreError
   deriving (Show, Exception)
 
-data ChatErrorType = CEGroupRole | CEGroupDuplicateMember deriving (Show, Exception)
+data ChatErrorType
+  = CEGroupRole
+  | CEGroupDuplicateMember ContactName
+  | CEGroupDuplicateMemberId
+  | CEGroupNotJoined GroupName
+  | CEGroupMemberNotReady
+  | CEGroupInternal String
+  deriving (Show, Exception)
 
 type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
 

src/Simplex/Chat/Help.hs

@@ -11,27 +11,26 @@ chatHelpInfo :: [StyledString]
 chatHelpInfo =
   map
     styleMarkdown
-    [ Markdown (Colored Cyan) "Using Simplex chat prototype.",
+    [ highlight "Using Simplex chat prototype.",
       "Follow these steps to set up a connection:",
       "",
-      Markdown (Colored Green) "Step 1: " <> Markdown (Colored Cyan) "/add bob" <> " -- Alice adds her contact, Bob (she can use any name).",
+      Markdown (Colored Green) "Step 1: " <> highlight "/add" <> " -- Alice adds a contact.",
       indent <> "Alice should send the invitation printed by the /add command",
       indent <> "to her contact, Bob, out-of-band, via any trusted channel.",
       "",
-      Markdown (Colored Green) "Step 2: " <> Markdown (Colored Cyan) "/connect alice <invitation>" <> " -- Bob accepts the invitation.",
-      indent <> "Bob also can use any name for his contact, Alice,",
-      indent <> "followed by the invitation he received out-of-band.",
+      Markdown (Colored Green) "Step 2: " <> highlight "/connect <invitation>" <> " -- Bob accepts the invitation.",
+      indent <> "Bob should use the invitation he received out-of-band.",
       "",
       Markdown (Colored Green) "Step 3: " <> "Bob and Alice are notified that the connection is set up,",
       indent <> "both can now send messages:",
-      indent <> Markdown (Colored Cyan) "@bob Hello, Bob!" <> " -- Alice messages Bob.",
-      indent <> Markdown (Colored Cyan) "@alice Hey, Alice!" <> " -- Bob replies to Alice.",
+      indent <> highlight "@bob Hello, Bob!" <> " -- Alice messages Bob (assuming Bob has display name 'bob').",
+      indent <> highlight "@alice Hey, Alice!" <> " -- Bob replies to Alice.",
       "",
       Markdown (Colored Green) "Other commands:",
-      indent <> Markdown (Colored Cyan) "/delete" <> " -- deletes contact and all messages with them.",
-      indent <> Markdown (Colored Cyan) "/markdown" <> " -- prints the supported markdown syntax.",
+      indent <> highlight "/delete <name>" <> " -- deletes contact and all messages with them.",
+      indent <> highlight "/markdown" <> " -- prints the supported markdown syntax.",
       "",
-      "The commands may be abbreviated to a single letter: " <> listCommands ["/a", "/c", "/d", "/m"]
+      "The commands may be abbreviated to a single letter: " <> listCommands ["/a", "/c", "/d", "/h", "/m"]
     ]
   where
     listCommands = mconcat . intersperse ", " . map highlight

src/Simplex/Chat/Protocol.hs

@@ -30,9 +30,9 @@ import Simplex.Messaging.Util (bshow)
 
 data ChatDirection (p :: AParty) where
   ReceivedDirectMessage :: ConnContact -> ChatDirection 'Agent
-  SentDirectMessage :: ConnContact -> ChatDirection 'Client
-  ReceivedGroupMessage :: Group -> ConnContact -> ChatDirection 'Agent
-  SentGroupMessage :: Group -> ChatDirection 'Client
+  SentDirectMessage :: Contact -> ChatDirection 'Client
+  ReceivedGroupMessage :: GroupName -> GroupMember -> ChatDirection 'Agent
+  SentGroupMessage :: GroupName -> ChatDirection 'Client
 
 deriving instance Eq (ChatDirection p)
 
@@ -48,12 +48,7 @@ data ChatMsgEvent
         content :: [MsgBodyContent]
       }
   | XInfo Profile
-  | XGrpInv
-      { fromMember :: (MemberId, GroupMemberRole),
-        invitedMember :: (MemberId, GroupMemberRole),
-        queueInfo :: SMPQueueInfo,
-        groupProfile :: GroupProfile
-      }
+  | XGrpInv GroupInvitation
   | XGrpAcpt MemberId
   | XGrpMemNew MemberId GroupMemberRole Profile
   | XGrpMemIntro MemberId GroupMemberRole Profile
@@ -99,8 +94,8 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
       [fromMemId, fromRole, memId, role, qInfo] -> do
         fromMember <- (,) <$> B64.decode fromMemId <*> toMemberRole fromRole
         invitedMember <- (,) <$> B64.decode memId <*> toMemberRole role
-        msg <- XGrpInv fromMember invitedMember <$> parseAll smpQueueInfoP qInfo <*> getJSON body
-        pure ChatMessage {chatMsgId, chatMsgEvent = msg, chatDAG}
+        inv <- GroupInvitation fromMember invitedMember <$> parseAll smpQueueInfoP qInfo <*> getJSON body
+        pure ChatMessage {chatMsgId, chatMsgEvent = XGrpInv inv, chatDAG}
       _ -> Left "x.grp.inv expects 5 parameters"
     "x.grp.acpt" -> case chatMsgParams of
       [memId] -> do
@@ -151,7 +146,7 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
     XInfo profile ->
       let chatMsgBody = rawWithDAG [jsonBody profile]
        in RawChatMessage {chatMsgId, chatMsgEvent = "x.info", chatMsgParams = [], chatMsgBody}
-    XGrpInv (fromMemId, fromRole) (memId, role) qInfo groupProfile ->
+    XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) qInfo groupProfile) ->
       let chatMsgParams =
             [ B64.encode fromMemId,
               serializeMemberRole fromRole,

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

src/Simplex/Chat/Styled.hs

@@ -3,10 +3,9 @@
 
 module Simplex.Chat.Styled
   ( StyledString (..),
-    plain,
+    StyledFormat (..),
     styleMarkdown,
     styleMarkdownText,
-    styled,
     sLength,
   )
 where

src/Simplex/Chat/Types.hs

@@ -20,9 +20,21 @@ import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics
-import Simplex.Messaging.Agent.Protocol (ConnId)
+import Simplex.Messaging.Agent.Protocol (ConnId, SMPQueueInfo)
 import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
 
+class IsContact a where
+  contactId' :: a -> Int64
+  profile' :: a -> Profile
+
+instance IsContact User where
+  contactId' = userContactId
+  profile' = profile
+
+instance IsContact Contact where
+  contactId' = contactId
+  profile' = profile
+
 data User = User
   { userId :: UserId,
     userContactId :: Int64,
@@ -52,7 +64,7 @@ data Group = Group
   { groupId :: Int64,
     localDisplayName :: GroupName,
     groupProfile :: GroupProfile,
-    members :: [(GroupMember, Connection)],
+    members :: [(GroupMember, Maybe Connection)],
     membership :: GroupMember
   }
   deriving (Eq, Show)
@@ -77,6 +89,24 @@ instance ToJSON GroupProfile where toEncoding = J.genericToEncoding J.defaultOpt
 
 instance FromJSON GroupProfile
 
+data GroupInvitation = GroupInvitation
+  { fromMember :: MemberInfo,
+    invitedMember :: MemberInfo,
+    queueInfo :: SMPQueueInfo,
+    groupProfile :: GroupProfile
+  }
+  deriving (Eq, Show)
+
+data ReceivedGroupInvitation = ReceivedGroupInvitation
+  { fromMember :: GroupMember,
+    invitedMember :: GroupMember,
+    queueInfo :: SMPQueueInfo,
+    groupProfile :: GroupProfile
+  }
+  deriving (Eq, Show)
+
+type MemberInfo = (MemberId, GroupMemberRole)
+
 data GroupMember = GroupMember
   { groupMemberId :: Int64,
     memberId :: MemberId,
@@ -133,8 +163,13 @@ fromBlobField_ p = \case
       Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
 
-data GroupMemberStatus = GSMemInvited | GSMemAccepted | GSMemConnected | GSMemReady
-  deriving (Eq, Show)
+data GroupMemberStatus
+  = GSMemInvited -- member received (or sent to) invitation
+  | GSMemAccepted -- member accepted invitation
+  | GSMemConnected -- member created the group connection with the inviting member
+  | GSMemReady -- member connections are forwarded to all previous members
+  | GSMemFull -- member created group connections with all previous members
+  deriving (Eq, Show, Ord)
 
 instance FromField GroupMemberStatus where fromField = fromTextField_ memberStatusT
 
@@ -146,6 +181,7 @@ memberStatusT = \case
   "accepted" -> Just GSMemAccepted
   "connected" -> Just GSMemConnected
   "ready" -> Just GSMemReady
+  "full" -> Just GSMemFull
   _ -> Nothing
 
 serializeMemberStatus :: GroupMemberStatus -> Text
@@ -154,6 +190,7 @@ serializeMemberStatus = \case
   GSMemAccepted -> "accepted"
   GSMemConnected -> "connected"
   GSMemReady -> "ready"
+  GSMemFull -> "full"
 
 data Connection = Connection
   { connId :: Int64,

src/Simplex/Chat/View.hs

@@ -15,6 +15,10 @@ module Simplex.Chat.View
     showReceivedMessage,
     showSentMessage,
     showGroupCreated,
+    showSentGroupInvitation,
+    showReceivedGroupInvitation,
+    showConnectedGroupMember,
+    showUserConnectedToGroup,
     safeDecodeUtf8,
   )
 where
@@ -22,6 +26,7 @@ where
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)
+import Data.Composition ((.:))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (DiffTime, UTCTime)
@@ -48,7 +53,7 @@ showChatError = printToView . chatError
 showContactDeleted :: ChatReader m => ContactName -> m ()
 showContactDeleted = printToView . contactDeleted
 
-showContactConnected :: ChatReader m => ContactName -> m ()
+showContactConnected :: ChatReader m => Contact -> m ()
 showContactConnected = printToView . contactConnected
 
 showContactDisconnected :: ChatReader m => ContactName -> m ()
@@ -60,29 +65,59 @@ showReceivedMessage c utcTime msg mOk = printToView =<< liftIO (receivedMessage
 showSentMessage :: ChatReader m => ContactName -> ByteString -> m ()
 showSentMessage c msg = printToView =<< liftIO (sentMessage c msg)
 
-showGroupCreated :: ChatReader m => GroupProfile -> m ()
+showGroupCreated :: ChatReader m => Group -> m ()
 showGroupCreated = printToView . groupCreated
 
+showSentGroupInvitation :: ChatReader m => Group -> ContactName -> m ()
+showSentGroupInvitation = printToView .: sentGroupInvitation
+
+showReceivedGroupInvitation :: ChatReader m => Group -> ContactName -> m ()
+showReceivedGroupInvitation = printToView .: receivedGroupInvitation
+
+showConnectedGroupMember :: ChatReader m => GroupName -> ContactName -> m ()
+showConnectedGroupMember = printToView .: connectedGroupMember
+
+showUserConnectedToGroup :: ChatReader m => GroupName -> m ()
+showUserConnectedToGroup = printToView . userConnectedToGroup
+
 invitation :: SMPQueueInfo -> [StyledString]
 invitation qInfo =
   [ "pass this invitation to your contact (via another channel): ",
     "",
     (plain . serializeSmpQueueInfo) qInfo,
     "",
-    "and ask them to connect: /c <name_for_you> <invitation_above>"
+    "and ask them to connect: " <> highlight' "/c <invitation_above>"
   ]
 
 contactDeleted :: ContactName -> [StyledString]
 contactDeleted c = [ttyContact c <> " is deleted"]
 
-contactConnected :: ContactName -> [StyledString]
-contactConnected c = [ttyContact c <> " is connected"]
+contactConnected :: Contact -> [StyledString]
+contactConnected ct = [ttyFullContact ct <> " is connected"]
 
 contactDisconnected :: ContactName -> [StyledString]
 contactDisconnected c = ["disconnected from " <> ttyContact c <> " - restart chat"]
 
-groupCreated :: GroupProfile -> [StyledString]
-groupCreated GroupProfile {displayName, fullName} = ["group " <> ttyGroup displayName <> " (" <> plain fullName <> ") is created"]
+groupCreated :: Group -> [StyledString]
+groupCreated g@Group {localDisplayName} =
+  [ "group " <> ttyFullGroup g <> " is created",
+    "use " <> highlight ("/a #" <> localDisplayName <> " <name>") <> " to add members"
+  ]
+
+sentGroupInvitation :: Group -> ContactName -> [StyledString]
+sentGroupInvitation g c = ["invitation to join the group " <> ttyFullGroup g <> " sent to " <> ttyContact c]
+
+receivedGroupInvitation :: Group -> ContactName -> [StyledString]
+receivedGroupInvitation g@Group {localDisplayName} c =
+  [ ttyContact c <> " invites you to join the group " <> ttyFullGroup g,
+    "use " <> highlight ("/j #" <> localDisplayName) <> " to accept"
+  ]
+
+connectedGroupMember :: GroupName -> ContactName -> [StyledString]
+connectedGroupMember g c = [ttyContact c <> " joined the group " <> ttyGroup g]
+
+userConnectedToGroup :: GroupName -> [StyledString]
+userConnectedToGroup g = ["you joined the group " <> ttyGroup g]
 
 receivedMessage :: ContactName -> UTCTime -> Text -> MsgIntegrity -> IO [StyledString]
 receivedMessage c utcTime msg mOk = do
@@ -124,10 +159,20 @@ msgPlain = map styleMarkdownText . T.lines
 
 chatError :: ChatError -> [StyledString]
 chatError = \case
+  ChatError err -> case err of
+    CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
+    CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
+    CEGroupRole -> ["insufficient role for this group command"]
+    CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> g)]
+    CEGroupMemberNotReady -> ["you cannot invite other members yet, try later"]
+    CEGroupInternal s -> ["chat group bug: " <> plain s]
+  -- e -> ["chat error: " <> plain (show e)]
   ChatErrorStore err -> case err of
     SEDuplicateName -> ["this display name is already used by user, contact or group"]
     SEContactNotFound c -> ["no contact " <> ttyContact c]
     SEContactNotReady c -> ["contact " <> ttyContact c <> " is not active yet"]
+    SEGroupNotFound g -> ["no group " <> ttyGroup g]
+    SEGroupAlreadyJoined -> ["you already joined this group"]
     e -> ["chat db error: " <> plain (show e)]
   ChatErrorAgent err -> case err of
     -- CONN e -> case e of
@@ -136,7 +181,7 @@ chatError = \case
     --   DUPLICATE -> ["contact " <> ttyContact c <> " already exists"]
     --   SIMPLEX -> ["contact " <> ttyContact c <> " did not accept invitation yet"]
     e -> ["smp agent error: " <> plain (show e)]
-  e -> ["chat error: " <> plain (show e)]
+  ChatErrorMessage e -> ["chat message error: " <> plain (show e)]
 
 printToView :: (MonadUnliftIO m, MonadReader ChatController m) => [StyledString] -> m ()
 printToView s = asks chatTerminal >>= liftIO . (`printToTerminal` s)
@@ -144,6 +189,10 @@ printToView s = asks chatTerminal >>= liftIO . (`printToTerminal` s)
 ttyContact :: ContactName -> StyledString
 ttyContact = styled (Colored Green)
 
+ttyFullContact :: Contact -> StyledString
+ttyFullContact Contact {localDisplayName, profile = Profile {fullName}} =
+  ttyContact localDisplayName <> optFullName localDisplayName fullName
+
 ttyToContact :: ContactName -> StyledString
 ttyToContact c = styled (Colored Cyan) $ "@" <> c <> " "
 
@@ -153,6 +202,21 @@ ttyFromContact c = styled (Colored Yellow) $ c <> "> "
 ttyGroup :: GroupName -> StyledString
 ttyGroup g = styled (Colored Blue) $ "#" <> g
 
+ttyFullGroup :: Group -> StyledString
+ttyFullGroup Group {localDisplayName, groupProfile = GroupProfile {fullName}} =
+  ttyGroup localDisplayName <> optFullName localDisplayName fullName
+
+optFullName :: Text -> Text -> StyledString
+optFullName localDisplayName fullName
+  | localDisplayName == fullName = ""
+  | otherwise = plain (" (" <> fullName <> ")")
+
+highlight :: StyledFormat a => a -> StyledString
+highlight = styled (Colored Cyan)
+
+highlight' :: String -> StyledString
+highlight' = highlight
+
 -- ttyFromGroup :: Group -> Contact -> StyledString
 -- ttyFromGroup (Group g) (Contact a) = styled (Colored Yellow) $ "#" <> g <> " " <> a <> "> "
 

src/Simplex/Chat/protocol.md

@@ -97,3 +97,63 @@ A -> group: `MSG: N x.grp.mem.ok G_MEM_ID_B`
 #### Send group message
 
 `MSG: N x.msg.new G_MEM_ROLE,<invitation> x.json:NNN <group_profile>`
+
+#### Group member statuses
+
+1. Me
+  - invited
+  - accepted
+  - connected to member who invited me
+  - announced to group
+    - x.grp.mem.new to group
+  - confirmed as connected to group
+    - this happens once member who invited me sends x.grp.mem.ok to group
+1. Member that I invited:
+  - invited
+  - accepted
+  - connected to me
+  - announced to group
+    - this happens after x.grp.mem.new but before introductions are sent.
+    This message is used to determine which members should be additionally introduced if they were announced before (or in "parallel").
+  - confirmed as connected to group
+2. Member who invited me
+  - invited_me
+  - connected to me
+    - I won't know whether this member was announced or confirmed to group - with the correctly functioning clients it must have happened.
+3. Prior member introduced to me after I joined (x.grp.mem.intro)
+  - introduced
+  - sent invitation
+  - connected
+  - connected directly (or confirmed existing contact)
+4. Member I was introduced to after that member joined (via x.grp.mem.fwd)
+  - announced via x.grp.mem.new
+  - received invitation
+  - connected
+  - connected directly (or confirmed existing contact)
+
+#### Introductions
+
+1. Introductions I sent to members I invited
+  - the time of joining is determined by the time of creating the connection and sending the x.grp.mem.new message to the group.
+  - introductions of the members who were connected before the new member should be sent - how to determine which members were connected before?
+    - use time stamp of creating connection, possibly in the member record - not very reliable, as time can change.
+    - use record ID - requires changing the schema, as currently members are added as invited, not as connected. So possibly invited members should be tracked in a separate table, and all members should still be tracked together to ensure that memberId is unique.
+    - record ID is also not 100% sufficient, as there can be forks in message history and I may need to intro the member I invited to the member that was announced after my member in my chronology, but in another graph branch.
+    - some other mechanism that allows to establish who should be connected to whom and whether I should introduce or another member (in case of forks - although maybe we both can introduce and eventually two group connections will be created between these members and they would just ignore the first one - although in cases of multiple branches in the graph it can be N connections).
+    - introductions/member connection statuses:
+      - created introduction
+      - sent to the member I invited
+      - received the invitation from the member I invited
+      - forwarded this invitation to previously connected member
+      - received confirmation from member I invited
+      - received confirmation from member I forwarded to
+      - completed introduction and recorded that these members are now fully connected to each other
+2. Introductions I received from the member who invited me
+  - if somebody else sends such introduction - this is an error (can be logged or ignored)
+  - duplicate memberId is an error (e.g. it is a member that was announced in the group broadcast - I should be introduced to this member, and not the other way around? Although it can happen in case of fork and maybe I should establish the connection anyway).
+  - member connection status in this case is just a member status from part 3, so maybe no need to track invitations separately and just put SMPQueueInfo on member record.
+3. Invitation forwarded to me by any prior member
+  - any admin/owner can add members, so they can forward their queue invitations - I should just check forwarding member permission
+  - duplicate memberId is an error
+  - unannounced memberId is an error - I should have seen member announcement prior to receiving this forwarded invitation. Fork would not happen here as it is the same member that announces and forwards the invitation, so they should be in order.
+  - member connection status in this case is just a member status from part 4, so maybe no need to track invitations separately and just put SMPQueueInfo on member record.

tests/ChatClient.hs

@@ -13,6 +13,7 @@ import Simplex.Chat.Controller (ChatController (..))
 import Simplex.Chat.Options
 import Simplex.Chat.Store
 import Simplex.Chat.Types (Profile)
+import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
 import qualified System.Terminal as C
 import System.Terminal.Internal (VirtualTerminal, VirtualTerminalSettings (..), withVirtualTerminal)
 
@@ -51,6 +52,8 @@ virtualSimplexChat dbFile profile = do
 
 testChat2 :: Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO ()
 testChat2 p1 p2 test = do
+  createDirectoryIfMissing False "tests/tmp"
   tc1 <- virtualSimplexChat testDB1 p1
   tc2 <- virtualSimplexChat testDB2 p2
   test tc1 tc2
+  removeDirectoryRecursive "tests/tmp"

tests/ChatTests.hs

@@ -18,16 +18,23 @@ aliceProfile = Profile {displayName = "alice", fullName = "Alice"}
 bobProfile :: Profile
 bobProfile = Profile {displayName = "bob", fullName = "Bob"}
 
-testAddContact :: Spec
-testAddContact = describe "add chat contact" $
-  it "add contact and send/receive message" $
-    testChat2 aliceProfile bobProfile $ \alice bob -> do
+chatTests :: Spec
+chatTests = do
+  describe "direct messages" $
+    it "add contact and send/receive message" testAddContact
+  describe "chat groups" $
+    it "add contacts, create group and send/receive messages" testGroup
+
+testAddContact :: IO ()
+testAddContact =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
       alice ##> "/a"
       Just inv <- invitation <$> getWindow alice
       bob ##> ("/c " <> inv)
       concurrently_
-        (bob <## "alice is connected")
-        (alice <## "bob is connected")
+        (bob <## "alice (Alice) is connected")
+        (alice <## "bob (Bob) is connected")
       alice #> "@bob hello"
       bob <# "alice> hello"
       bob #> "@alice hi"
@@ -37,8 +44,8 @@ testAddContact = describe "add chat contact" $
       Just inv' <- invitation <$> getWindow alice
       bob ##> ("/c " <> inv')
       concurrently_
-        (bob <## "alice_1 is connected")
-        (alice <## "bob_1 is connected")
+        (bob <## "alice_1 (Alice) is connected")
+        (alice <## "bob_1 (Bob) is connected")
       alice #> "@bob_1 hello"
       bob <# "alice_1> hello"
       bob #> "@alice_1 hi"
@@ -46,21 +53,46 @@ testAddContact = describe "add chat contact" $
       -- test deleting contact
       alice ##> "/d bob_1"
       alice <## "bob_1 is deleted"
-      chatCommand alice "@bob_1 hey"
+      alice #:> "@bob_1 hey"
       alice <## "no contact bob_1"
 
+testGroup :: IO ()
+testGroup =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      alice #:> "/g #team"
+      -- TODO this occasionally fails in case getWindow is run before the command above is printed
+      alice <## "use /a #team <name> to add members"
+      alice ##> "/a #team bob admin"
+      alice <## "invitation to join the group #team sent to bob"
+      bob <## "use /j #team to accept"
+      bob ##> "/j #team"
+      concurrently_
+        (alice <## "bob joined the group #team")
+        (bob <## "you joined the group #team")
+
+connectUsers :: TestCC -> TestCC -> IO ()
+connectUsers cc1 cc2 = do
+  cc1 ##> "/a"
+  Just inv <- invitation <$> getWindow cc1
+  cc2 ##> ("/c " <> inv)
+  concurrently_
+    (cc2 <## "alice (Alice) is connected")
+    (cc1 <## "bob (Bob) is connected")
+
 (##>) :: TestCC -> String -> IO ()
 (##>) cc cmd = do
-  chatCommand cc cmd
+  cc #:> cmd
   cc <## cmd
 
 (#>) :: TestCC -> String -> IO ()
 (#>) cc cmd = do
-  chatCommand cc cmd
+  cc #:> cmd
   cc <# cmd
 
-chatCommand :: TestCC -> String -> IO ()
-chatCommand (TestCC cc _ _) cmd = atomically $ writeTBQueue (inputQ cc) $ InputCommand cmd
+(#:>) :: TestCC -> String -> IO ()
+(#:>) (TestCC cc _ _) cmd = atomically $ writeTBQueue (inputQ cc) $ InputCommand cmd
 
 (<##) :: TestCC -> String -> Expectation
 cc <## line = (lastOutput <$> getWindow cc) `shouldReturn` line

tests/Test.hs

@@ -1,14 +1,11 @@
 import ChatTests
 import MarkdownTests
 import ProtocolTests
-import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
 import Test.Hspec
 
 main :: IO ()
 main = do
-  createDirectoryIfMissing False "tests/tmp"
   hspec $ do
     describe "SimpleX chat markdown" markdownTests
     describe "SimpleX chat protocol" protocolTests
-    xdescribe "SimpleX chat client" testAddContact
-  removeDirectoryRecursive "tests/tmp"
+    xdescribe "SimpleX chat client" chatTests