add implementation plan

* switch to ghc-8.10.7 (lts-18.17 resolver) (#125)

* update simplex.md

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>

.github/changelog_conf.json

@@ -1,4 +1,4 @@
 {
-  "template": "${{UNCATEGORIZED}}",
-  "pr_template": "- ${{TITLE}}\n"
+  "template": "Commits:\n${{UNCATEGORIZED}}",
+  "pr_template": "- ${{TITLE}}"
 }

.github/workflows/build.yml

@@ -75,7 +75,7 @@ jobs:
       - name: Setup Stack
         uses: haskell/actions/setup@v1
         with:
-          ghc-version: '8.8.4'
+          ghc-version: '8.10.7'
           enable-stack: true
           stack-version: 'latest'
 

migrations/20220106_group_members_inv_queue_info.sql

@@ -0,0 +1,3 @@
+ALTER TABLE group_members ADD inv_queue_info BLOB;
+
+CREATE INDEX idx_groups_inv_queue_info ON groups (inv_queue_info);

package.yaml

@@ -1,5 +1,5 @@
 name: simplex-chat
-version: 0.5.4
+version: 0.5.5
 #synopsis:
 #description:
 homepage: https://github.com/simplex-chat/simplex-chat#readme
@@ -13,7 +13,7 @@ extra-source-files:
 
 dependencies:
   - aeson == 1.5.*
-  - ansi-terminal == 0.10.*
+  - ansi-terminal >= 0.10 && < 0.12
   - attoparsec == 0.13.*
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
@@ -23,13 +23,13 @@ dependencies:
   - cryptonite >= 0.27 && < 0.30
   - directory == 1.3.*
   - exceptions == 0.10.*
-  - file-embed == 0.0.14.*
+  - file-embed >= 0.0.14 && < 0.0.16
   - filepath == 1.4.*
   - mtl == 2.2.*
-  - optparse-applicative == 0.15.*
+  - optparse-applicative >= 0.15 && < 0.17
   - process == 1.6.*
   - simple-logger == 0.1.*
-  - simplexmq == 0.5.*
+  - simplexmq >= 0.5.2 && < 0.6
   - sqlite-simple == 0.4.*
   - stm == 2.5.*
   - terminal == 0.2.*

rfcs/2022-01-07-notification-server.md

@@ -0,0 +1,78 @@
+# SimpleX Notification Server for SimpleX Chat
+
+## Background and motivation
+
+SimpleX Chat clients should receive message notifications when not being online and/or subscribed to SMP servers.
+
+To avoid revealing identities of clients directly to SMP servers via any kind of push notification tokens, a new party called SimpleX Notification Server is introduced to act as a service for subscribing to SMP server queue notifications on behalf of clients and sending push notifications to them.
+
+## Proposal
+
+Communication between SimpleX Chat clients and SimpleX Notification Servers is carried out using SMP protocols (via SMP agents), which provides stronger security guarantees out of the box compared to HTTPS. Communication between SimpleX Notification Servers and SMP servers is also carried out using SMP protocol, with SimpleX Notification Server using an SMP client internally.
+
+Before establishing message notifications:
+
+1. SimpleX Notification Server creates a permanent address via SMP protocol.
+
+2. This address is supplied to SimpleX Chat client via configuration or options, or baked in.
+
+3. If SimpleX Chat client enables message notifications (for all or given chat connections) it establishes connection(s) to SimpleX Notification Server(s).
+
+   TBC:
+
+   - establish connection(s) to Notification Server(s) preemptively or on-demand;
+   - one connection per Notification Server or per chat connection (probably the latter doesn't make sense);
+   - to one or many Notification Servers.
+
+Order of communication to establish message notifications goes as follows:
+
+1. SimpleX Chat client requests SMP server to establish notifications for a queue using NKEY command containing a public key for authentication of NSUB command.
+2. SMP server replies to SimpleX Chat client with NID response containing the queue's ID to be used for NSUB command.
+3. SimpleX Chat client requests SimpleX Notification Server to subscribe to message notifications for the queue by sending `s.post` message (see `2022-01-07-simplex-services.md` rfc) to the [previously ?] established connection with Notification Server. The message contains SMP server address, notifier ID from SMP server's NID response, notifier private key (public key was provided to SMP server in NKEY command) and some kind of push notification token.
+4. SimpleX Notification Server sends NSUB command to the SMP server containing notifier ID and signed with notifier key.
+5. SMP server responds to SimpleX Notification Server with OK or NMSG if messages are available. After that SMP server sends NMSG notifications to SimpleX Notification Server for new available message. TBC - for all messages? some heuristics?
+6. SimpleX Notification Server sends `s.ok` (`s.resp.ok`?) message to SimpleX Chat client signaling it has subscribed to notifications.
+7. SimpleX Notification Server sends push notifications to SimpleX Chat client on new NMSG notifications from SMP server via provided push notification token.
+
+## Implementation plan
+
+https://github.com/simplex-chat/simplexmq/pull/314
+
+Make agent work with postgres:
+- fix issue with writing binary data
+- make all tests pass with postgres
+- revise instances, error handling, transaction settings
+- class abstracting `execute`, `query`, `Only`, error handling, probably more
+- separate migration logic
+  - Q duplicate? (as now)
+  - Q or reuse store methods + store method for `exec`
+- parameterize agent to run either on sqlite or postgres
+- \* move postgres instances to separate package to avoid compiling for mobile app
+- make tests run for both sqlite and postgres
+
+Protocol design:
+- service protocol
+- notifications sub-protocol
+
+Push notifications:
+- investigate sending push notifications to ios, (*) android
+- notification server code running with postgres agent
+  - communication with smp servers
+  - communication with clients
+  - notification specific store
+    - Q same database? same server different database?
+    - Q how to reuse database code? notification specific methods? -> should be unavailable to sqlite agent
+  - Q other areas?
+- notification server deployed
+  - Q deployed where and how (probably a script similar to linode using systemd)
+    - \* should be built on github to be downloaded as binary, can be shortcutted
+  - Q spinning up postgres - postgres server, db, settings (password?)
+  - Q transport - will self signed certificates work for push notifications? or will CA signed certificates be required?
+- notifications at client
+  - client to request notifications from notification server, (*) parameterized
+  - store
+  - client to wake up and selectively subscribe to smp server, then notify
+  - api for wake up, api for response
+    - Q will separarate c binding be needed?
+  - logic in swift, (*) kotlin
+- test & fix

rfcs/2022-01-07-simplex-services.md

@@ -0,0 +1,37 @@
+# SimpleX Services
+
+## Background and motivation
+
+SimpleX clients communicating with SimpleX services require message format separate from SimpleX Chat `x` namespace.
+
+## Proposal
+
+Use `s` (for "service") namespace with REST like messages for requests and responses, e.g.
+
+```
+s.post resource data
+s.get resource
+...
+```
+
+Requests only require resource locations at the service, location of the service itself is determined by the SMP connection.
+
+Responses can either have separate messages:
+
+```
+s.ok
+s.not_found
+...
+```
+
+Or be united under a single "response" envelope:
+
+```
+s.resp.ok
+s.resp.not_found
+...
+```
+
+## Schema migration
+
+## Implementation plan

simplex-chat.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplex-chat
-version:        0.5.4
+version:        0.5.5
 category:       Web, System, Services, Cryptography
 homepage:       https://github.com/simplex-chat/simplex-chat#readme
 author:         Evgeny Poberezkin
@@ -40,7 +40,7 @@ library
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
   build-depends:
       aeson ==1.5.*
-    , ansi-terminal ==0.10.*
+    , ansi-terminal >=0.10 && <0.12
     , attoparsec ==0.13.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
@@ -50,13 +50,13 @@ library
     , cryptonite >=0.27 && <0.30
     , directory ==1.3.*
     , exceptions ==0.10.*
-    , file-embed ==0.0.14.*
+    , file-embed >=0.0.14 && <0.0.16
     , filepath ==1.4.*
     , mtl ==2.2.*
-    , optparse-applicative ==0.15.*
+    , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , simple-logger ==0.1.*
-    , simplexmq ==0.5.*
+    , simplexmq >=0.5.2 && <0.6
     , sqlite-simple ==0.4.*
     , stm ==2.5.*
     , terminal ==0.2.*
@@ -75,7 +75,7 @@ executable simplex-chat
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==1.5.*
-    , ansi-terminal ==0.10.*
+    , ansi-terminal >=0.10 && <0.12
     , attoparsec ==0.13.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
@@ -85,14 +85,14 @@ executable simplex-chat
     , cryptonite >=0.27 && <0.30
     , directory ==1.3.*
     , exceptions ==0.10.*
-    , file-embed ==0.0.14.*
+    , file-embed >=0.0.14 && <0.0.16
     , filepath ==1.4.*
     , mtl ==2.2.*
-    , optparse-applicative ==0.15.*
+    , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , simple-logger ==0.1.*
     , simplex-chat
-    , simplexmq ==0.5.*
+    , simplexmq >=0.5.2 && <0.6
     , sqlite-simple ==0.4.*
     , stm ==2.5.*
     , terminal ==0.2.*
@@ -116,7 +116,7 @@ test-suite simplex-chat-test
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
   build-depends:
       aeson ==1.5.*
-    , ansi-terminal ==0.10.*
+    , ansi-terminal >=0.10 && <0.12
     , async ==2.2.*
     , attoparsec ==0.13.*
     , base >=4.7 && <5
@@ -127,16 +127,16 @@ test-suite simplex-chat-test
     , cryptonite >=0.27 && <0.30
     , directory ==1.3.*
     , exceptions ==0.10.*
-    , file-embed ==0.0.14.*
+    , file-embed >=0.0.14 && <0.0.16
     , filepath ==1.4.*
     , hspec ==2.7.*
     , mtl ==2.2.*
     , network ==3.1.*
-    , optparse-applicative ==0.15.*
+    , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
     , simple-logger ==0.1.*
     , simplex-chat
-    , simplexmq ==0.5.*
+    , simplexmq >=0.5.2 && <0.6
     , sqlite-simple ==0.4.*
     , stm ==2.5.*
     , terminal ==0.2.*

simplex.md

@@ -4,8 +4,8 @@
 
 Existing chat platforms and protocols have some or all of the following problems:
 
-- Lack of privacy of the conversation, partially caused by [E2EE][1] implementations.
-- Lack of privacy of the user profile and connections.
+- Lack of privacy of the user profile and connections (meta-data privacy).
+- No protection (or only optional protection) of [E2EE][1] implementations from MITM attacks.
 - Unsolicited messages (spam and abuse).
 - Lack of data ownership and protection.
 - Complexity of usage for all non-centralized protocols to non-technical users.

src/Simplex/Chat.hs

@@ -253,19 +253,27 @@ processChatCommand user@User {userId, profile} = \case
   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
+        GroupMember {memberRole = userRole, memberId = userMemberId} = membership
     when (userRole < GRAdmin || userRole < memRole) $ chatError CEGroupUserRole
     when (memberStatus membership == GSMemInvited) $ chatError (CEGroupNotJoined gName)
     unless (memberActive membership) $ chatError CEGroupMemberNotActive
-    when (isJust $ contactMember contact members) $ chatError (CEGroupDuplicateMember cName)
-    gVar <- asks idsDrg
-    (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation)
-    GroupMember {memberId} <- withStore $ \st -> createContactGroupMember st gVar user groupId contact memRole agentConnId
-    let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
-    sendDirectMessage (contactConn contact) msg
-    showSentGroupInvitation gName cName
-    setActive $ ActiveG gName
+    let sendInvitation memberId cReq = do
+          sendDirectMessage (contactConn contact) $
+            XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
+          showSentGroupInvitation gName cName
+          setActive $ ActiveG gName
+    case contactMember contact members of
+      Nothing -> do
+        gVar <- asks idsDrg
+        (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation)
+        GroupMember {memberId} <- withStore $ \st -> createContactMember st gVar user groupId contact memRole agentConnId cReq
+        sendInvitation memberId cReq
+      Just GroupMember {groupMemberId, memberId, memberStatus}
+        | memberStatus == GSMemInvited ->
+          withStore (\st -> getMemberInvitation st user groupMemberId) >>= \case
+            Just cReq -> sendInvitation memberId cReq
+            Nothing -> showCannotResendInvitation gName cName
+        | otherwise -> chatError (CEGroupDuplicateMember cName)
   JoinGroup gName -> do
     ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName
     agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId userMember
@@ -296,7 +304,7 @@ processChatCommand user@User {userId, profile} = \case
     let s = memberStatus membership
         canDelete =
           memberRole membership == GROwner
-            || (s == GSMemRemoved || s == GSMemLeft || s == GSMemGroupDeleted)
+            || (s == GSMemRemoved || s == GSMemLeft || s == GSMemGroupDeleted || s == GSMemInvited)
     unless canDelete $ chatError CEGroupUserRole
     when (memberActive membership) $ sendGroupMessage members XGrpDel
     mapM_ deleteMemberConnection members
@@ -305,7 +313,7 @@ processChatCommand user@User {userId, profile} = \case
   ListMembers gName -> do
     group <- withStore $ \st -> getGroup st user gName
     showGroupMembers group
-  ListGroups -> withStore (`getUserGroupNames` userId) >>= showGroupsList
+  ListGroups -> withStore (`getUserGroupDetails` userId) >>= showGroupsList
   SendGroupMessage gName msg -> do
     -- TODO save pending message delivery for members without connections
     Group {members, membership} <- withStore $ \st -> getGroup st user gName
@@ -444,17 +452,20 @@ subscribeUserConnections = void . runExceptT $ do
         (subscribe (contactConnId ct) >> showContactSubscribed c) `catchError` showContactSubError c
     subscribeGroups user = do
       groups <- withStore (`getUserGroups` user)
-      forM_ groups $ \Group {members, membership, localDisplayName = g} -> do
+      forM_ groups $ \g@Group {members, membership, localDisplayName = gn} -> do
         let connectedMembers = mapMaybe (\m -> (m,) <$> memberConnId m) members
-        if null connectedMembers
-          then
-            if memberActive membership
-              then showGroupEmpty g
-              else showGroupRemoved g
-          else do
-            forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) ->
-              subscribe cId `catchError` showMemberSubError g c
-            showGroupSubscribed g
+        if memberStatus membership == GSMemInvited
+          then showGroupInvitation g
+          else
+            if null connectedMembers
+              then
+                if memberActive membership
+                  then showGroupEmpty g
+                  else showGroupRemoved g
+              else do
+                forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) ->
+                  subscribe cId `catchError` showMemberSubError gn c
+                showGroupSubscribed g
     subscribeFiles user = do
       withStore (`getLiveSndFileTransfers` user) >>= mapM_ subscribeSndFile
       withStore (`getLiveRcvFileTransfers` user) >>= mapM_ subscribeRcvFile

src/Simplex/Chat/Controller.hs

@@ -26,7 +26,7 @@ import System.IO (Handle)
 import UnliftIO.STM
 
 versionNumber :: String
-versionNumber = "0.5.4"
+versionNumber = "0.5.5"
 
 data ChatConfig = ChatConfig
   { agentConfig :: AgentConfig,

src/Simplex/Chat/Store.hs

@@ -49,9 +49,10 @@ module Simplex.Chat.Store
     getGroup,
     deleteGroup,
     getUserGroups,
-    getUserGroupNames,
+    getUserGroupDetails,
     getGroupInvitation,
-    createContactGroupMember,
+    createContactMember,
+    getMemberInvitation,
     createMemberConnection,
     updateGroupMemberStatus,
     createNewGroupMember,
@@ -891,21 +892,31 @@ createNewGroup st gVar user groupProfile =
     membership <- createContactMember_ db user groupId user (memberId, GROwner) GCUserMember GSMemCreator IBUser
     pure $ Right Group {groupId, localDisplayName = displayName, groupProfile, members = [], membership}
 
--- | creates a new group record for the group the current user was invited to
+-- | creates a new group record for the group the current user was invited to, or returns an existing one
 createGroupInvitation ::
   StoreMonad m => SQLiteStore -> User -> Contact -> GroupInvitation -> m Group
-createGroupInvitation st user contact GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} =
+createGroupInvitation st user@User {userId} contact GroupInvitation {fromMember, invitedMember, connRequest, 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 "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, connRequest, uId)
-      groupId <- insertedRowId db
-      member <- createContactMember_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown
-      membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact $ contactId contact)
-      pure Group {groupId, localDisplayName, groupProfile, members = [member], membership}
+    getGroupInvitationLdn_ db >>= \case
+      Nothing -> createGroupInvitation_ db
+      -- TODO treat the case that the invitation details could've changed
+      Just localDisplayName -> runExceptT $ fst <$> getGroup_ db user localDisplayName
+  where
+    getGroupInvitationLdn_ :: DB.Connection -> IO (Maybe GroupName)
+    getGroupInvitationLdn_ db =
+      listToMaybe . map fromOnly
+        <$> DB.query db "SELECT local_display_name FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1;" (connRequest, userId)
+    createGroupInvitation_ :: DB.Connection -> IO (Either StoreError Group)
+    createGroupInvitation_ db = do
+      let GroupProfile {displayName, fullName} = groupProfile
+      withLocalDisplayName db userId displayName $ \localDisplayName -> do
+        DB.execute db "INSERT INTO group_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
+        profileId <- insertedRowId db
+        DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, connRequest, userId)
+        groupId <- insertedRowId db
+        member <- createContactMember_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown
+        membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact $ contactId contact)
+        pure Group {groupId, localDisplayName, groupProfile, members = [member], membership}
 
 -- TODO return the last connection that is ready, not any last connection
 -- requires updating connection status
@@ -974,6 +985,7 @@ deleteGroup st User {userId} Group {groupId, members, localDisplayName} =
     forM_ members $ \m -> DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId m)
     DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId)
     DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
+    -- TODO ? delete group profile
     DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
 
 getUserGroups :: MonadUnliftIO m => SQLiteStore -> User -> m [Group]
@@ -982,16 +994,17 @@ getUserGroups st user@User {userId} =
     groupNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only userId)
     map fst . rights <$> mapM (runExceptT . getGroup_ db user) groupNames
 
-getUserGroupNames :: MonadUnliftIO m => SQLiteStore -> UserId -> m [(GroupName, Text)]
-getUserGroupNames st userId =
+getUserGroupDetails :: MonadUnliftIO m => SQLiteStore -> UserId -> m [(GroupName, Text, GroupMemberStatus)]
+getUserGroupDetails st userId =
   liftIO . withTransaction st $ \db ->
     DB.query
       db
       [sql|
-        SELECT g.local_display_name, p.full_name
+        SELECT g.local_display_name, p.full_name, m.member_status
         FROM groups g
         JOIN group_profiles p USING (group_profile_id)
-        WHERE g.user_id = ?
+        JOIN group_members m USING (group_id)
+        WHERE g.user_id = ? AND m.member_category = 'user'
       |]
       (Only userId)
 
@@ -1018,15 +1031,20 @@ toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, membe
       activeConn = Nothing
    in GroupMember {..}
 
-createContactGroupMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> m GroupMember
-createContactGroupMember st gVar user groupId contact memberRole agentConnId =
+createContactMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> m GroupMember
+createContactMember st gVar user groupId contact memberRole agentConnId connRequest =
   liftIOEither . withTransaction st $ \db ->
     createWithRandomId gVar $ \memId -> do
-      member <- createContactMember_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser
-      groupMemberId <- insertedRowId db
+      member@GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest)
       void $ createMemberConnection_ db (userId user) groupMemberId agentConnId Nothing 0
       pure member
 
+getMemberInvitation :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Maybe ConnReqInvitation)
+getMemberInvitation st User {userId} groupMemberId =
+  liftIO . withTransaction st $ \db ->
+    join . listToMaybe . map fromOnly
+      <$> DB.query db "SELECT inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?;" (groupMemberId, userId)
+
 createMemberConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> GroupMember -> ConnId -> m ()
 createMemberConnection st userId GroupMember {groupMemberId} agentConnId =
   liftIO . withTransaction st $ \db ->
@@ -1252,7 +1270,11 @@ createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe I
 createMemberConnection_ db userId groupMemberId = createConnection_ db userId ConnMember (Just groupMemberId)
 
 createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
-createContactMember_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy = do
+createContactMember_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy =
+  createContactMemberInv_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy Nothing
+
+createContactMemberInv_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember
+createContactMemberInv_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy connRequest = do
   insertMember_
   groupMemberId <- insertedRowId db
   let memberProfile = profile' userOrContact
@@ -1267,12 +1289,12 @@ createContactMember_ db User {userId, userContactId} groupId userOrContact (memb
         [sql|
           INSERT INTO group_members
             ( group_id, member_id, member_role, member_category, member_status, invited_by,
-              user_id, local_display_name, contact_profile_id, contact_id)
+              user_id, local_display_name, contact_profile_id, contact_id, inv_queue_info)
           VALUES
             (:group_id,:member_id,:member_role,:member_category,:member_status,:invited_by,
              :user_id,:local_display_name,
               (SELECT contact_profile_id FROM contacts WHERE contact_id = :contact_id),
-              :contact_id)
+              :contact_id, :inv_queue_info)
         |]
         [ ":group_id" := groupId,
           ":member_id" := memberId,
@@ -1282,7 +1304,8 @@ createContactMember_ db User {userId, userContactId} groupId userOrContact (memb
           ":invited_by" := fromInvitedBy userContactId invitedBy,
           ":user_id" := userId,
           ":local_display_name" := localDisplayName' userOrContact,
-          ":contact_id" := contactId' userOrContact
+          ":contact_id" := contactId' userOrContact,
+          ":inv_queue_info" := connRequest
         ]
 
 getViaGroupMember :: MonadUnliftIO m => SQLiteStore -> User -> Contact -> m (Maybe (GroupName, GroupMember))

src/Simplex/Chat/View.hs

@@ -31,6 +31,7 @@ module Simplex.Chat.View
     showGroupSubscribed,
     showGroupEmpty,
     showGroupRemoved,
+    showGroupInvitation,
     showMemberSubError,
     showReceivedMessage,
     showReceivedGroupMessage,
@@ -57,6 +58,7 @@ module Simplex.Chat.View
     showGroupDeletedUser,
     showGroupDeleted,
     showSentGroupInvitation,
+    showCannotResendInvitation,
     showReceivedGroupInvitation,
     showJoinedGroupMember,
     showUserJoinedGroup,
@@ -174,15 +176,19 @@ showUserContactLinkSubscribed = printToView ["Your address is active! To show: "
 showUserContactLinkSubError :: ChatReader m => ChatError -> m ()
 showUserContactLinkSubError = printToView . userContactLinkSubError
 
-showGroupSubscribed :: ChatReader m => GroupName -> m ()
+showGroupSubscribed :: ChatReader m => Group -> m ()
 showGroupSubscribed = printToView . groupSubscribed
 
-showGroupEmpty :: ChatReader m => GroupName -> m ()
+showGroupEmpty :: ChatReader m => Group -> m ()
 showGroupEmpty = printToView . groupEmpty
 
-showGroupRemoved :: ChatReader m => GroupName -> m ()
+showGroupRemoved :: ChatReader m => Group -> m ()
 showGroupRemoved = printToView . groupRemoved
 
+showGroupInvitation :: ChatReader m => Group -> m ()
+showGroupInvitation Group {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} =
+  printToView [groupInvitation ldn fullName]
+
 showMemberSubError :: ChatReader m => GroupName -> ContactName -> ChatError -> m ()
 showMemberSubError = printToView .:. memberSubError
 
@@ -267,6 +273,9 @@ showGroupDeleted = printToView .: groupDeleted
 showSentGroupInvitation :: ChatReader m => GroupName -> ContactName -> m ()
 showSentGroupInvitation = printToView .: sentGroupInvitation
 
+showCannotResendInvitation :: ChatReader m => GroupName -> ContactName -> m ()
+showCannotResendInvitation = printToView .: cannotResendInvitation
+
 showReceivedGroupInvitation :: ChatReader m => Group -> ContactName -> GroupMemberRole -> m ()
 showReceivedGroupInvitation = printToView .:. receivedGroupInvitation
 
@@ -297,7 +306,7 @@ showLeftMember = printToView .: leftMember
 showGroupMembers :: ChatReader m => Group -> m ()
 showGroupMembers = printToView . groupMembers
 
-showGroupsList :: ChatReader m => [(GroupName, Text)] -> m ()
+showGroupsList :: ChatReader m => [(GroupName, Text, GroupMemberStatus)] -> m ()
 showGroupsList = printToView . groupsList
 
 showContactsMerged :: ChatReader m => Contact -> Contact -> m ()
@@ -397,14 +406,14 @@ userContactLinkSubError e =
     "to delete your address: " <> highlight' "/da"
   ]
 
-groupSubscribed :: GroupName -> [StyledString]
-groupSubscribed g = [ttyGroup g <> ": connected to server(s)"]
+groupSubscribed :: Group -> [StyledString]
+groupSubscribed g = [ttyFullGroup g <> ": connected to server(s)"]
 
-groupEmpty :: GroupName -> [StyledString]
-groupEmpty g = [ttyGroup g <> ": group is empty"]
+groupEmpty :: Group -> [StyledString]
+groupEmpty g = [ttyFullGroup g <> ": group is empty"]
 
-groupRemoved :: GroupName -> [StyledString]
-groupRemoved g = [ttyGroup g <> ": you are no longer a member or group deleted"]
+groupRemoved :: Group -> [StyledString]
+groupRemoved g = [ttyFullGroup g <> ": you are no longer a member or group deleted"]
 
 memberSubError :: GroupName -> ContactName -> ChatError -> [StyledString]
 memberSubError g c e = [ttyGroup g <> " member " <> ttyContact c <> " error: " <> sShow e]
@@ -427,6 +436,12 @@ groupDeleted_ g m = [ttyGroup g <> ": " <> memberOrUser m <> " deleted the group
 sentGroupInvitation :: GroupName -> ContactName -> [StyledString]
 sentGroupInvitation g c = ["invitation to join the group " <> ttyGroup g <> " sent to " <> ttyContact c]
 
+cannotResendInvitation :: GroupName -> ContactName -> [StyledString]
+cannotResendInvitation g c =
+  [ ttyContact c <> " is already invited to group " <> ttyGroup g,
+    "to re-send invitation: " <> highlight ("/rm " <> g <> " " <> c) <> ", " <> highlight ("/a " <> g <> " " <> c)
+  ]
+
 receivedGroupInvitation :: Group -> ContactName -> GroupMemberRole -> [StyledString]
 receivedGroupInvitation g@Group {localDisplayName} c role =
   [ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (serializeMemberRole role),
@@ -492,11 +507,22 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov
       GSMemCreator -> "created group"
       _ -> ""
 
-groupsList :: [(GroupName, Text)] -> [StyledString]
+groupsList :: [(GroupName, Text, GroupMemberStatus)] -> [StyledString]
 groupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
-groupsList gs = map groupNames $ sort gs
+groupsList gs = map groupSS $ sort gs
   where
-    groupNames (displayName, fullName) = ttyGroup displayName <> optFullName displayName fullName
+    groupSS (displayName, fullName, GSMemInvited) = groupInvitation displayName fullName
+    groupSS (displayName, fullName, _) = ttyGroup displayName <> optFullName displayName fullName
+
+groupInvitation :: GroupName -> Text -> StyledString
+groupInvitation displayName fullName =
+  highlight ("#" <> displayName)
+    <> optFullName displayName fullName
+    <> " - you are invited ("
+    <> highlight ("/j " <> displayName)
+    <> " to join, "
+    <> highlight ("/d #" <> displayName)
+    <> " to delete invitation)"
 
 contactsMerged :: Contact -> Contact -> [StyledString]
 contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayName = c2} =
@@ -716,7 +742,7 @@ chatError = \case
     CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]
     CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> g)]
     CEGroupMemberNotActive -> ["you cannot invite other members yet, try later"]
-    CEGroupMemberUserRemoved -> ["you are no longer the member of the group"]
+    CEGroupMemberUserRemoved -> ["you are no longer a member of the group"]
     CEGroupMemberNotFound c -> ["contact " <> ttyContact c <> " is not a group member"]
     CEGroupInternal s -> ["chat group bug: " <> plain s]
     CEFileNotFound f -> ["file not found: " <> plain f]

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-17.12
+resolver: lts-18.21
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -36,11 +36,9 @@ packages:
 #
 extra-deps:
   - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
-  - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718
   - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
-  - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
   - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
-  - simplexmq-0.5.0@sha256:3d9b84d986df7409839c19455a376722837d52a646cb5d136037cadd0b5a4b76,7828
+  - simplexmq-0.5.2@sha256:3544e479f353c1bbc6aa9405ef6976b78364f437d8af9cc45b9e0b228429e240,7884
   # - ../simplexmq
   # - github: simplex-chat/simplexmq
   #   commit: f15067cf6891bda3216c6cf6d2e3ecdba9b7269e

tests/ChatClient.hs

@@ -145,6 +145,7 @@ serverCfg =
   ServerConfig
     { transports = [(serverPort, transport @TCP)],
       tbqSize = 1,
+      serverTbqSize = 1,
       msgQueueQuota = 4,
       queueIdBytes = 12,
       msgIdBytes = 6,

tests/ChatTests.hs

@@ -37,7 +37,10 @@ chatTests = do
     it "add contacts, create group and send/receive messages" testGroup
     it "create and join group with 4 members" testGroup2
     it "create and delete group" testGroupDelete
+    it "invitee delete group when in status invited" testGroupDeleteWhenInvited
+    it "re-add member in status invited" testGroupReAddInvited
     it "remove contact from group and add again" testGroupRemoveAdd
+    it "list groups containing group invitations" testGroupList
   describe "user profiles" $
     it "update user profiles and notify contacts" testUpdateProfile
   describe "sending and receiving files" $ do
@@ -166,7 +169,7 @@ testGroup =
         (bob <# "#team alice> hello")
         (cath </)
       cath #> "#team hello"
-      cath <## "you are no longer the member of the group"
+      cath <## "you are no longer a member of the group"
       bob <##> cath
 
 testGroup2 :: IO ()
@@ -291,7 +294,7 @@ testGroup2 =
           (dan </)
         ]
       dan #> "#club how is it going?"
-      dan <## "you are no longer the member of the group"
+      dan <## "you are no longer a member of the group"
       dan <##> cath
       dan <##> alice
       -- member leaves
@@ -312,7 +315,7 @@ testGroup2 =
         (alice <# "#club cath> hey")
         (bob </)
       bob #> "#club how is it going?"
-      bob <## "you are no longer the member of the group"
+      bob <## "you are no longer a member of the group"
       bob <##> cath
       bob <##> alice
 
@@ -334,7 +337,69 @@ testGroupDelete =
       bob ##> "/d #team"
       bob <## "#team: you deleted the group"
       cath #> "#team hi"
-      cath <## "you are no longer the member of the group"
+      cath <## "you are no longer a member of the group"
+
+testGroupDeleteWhenInvited :: IO ()
+testGroupDeleteWhenInvited =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      alice ##> "/g team"
+      alice <## "group #team is created"
+      alice <## "use /a team <name> to add members"
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## "use /j team to accept"
+        ]
+      bob ##> "/d #team"
+      bob <## "#team: you deleted the group"
+      -- alice doesn't receive notification that bob deleted group,
+      -- but she can re-add bob
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## "use /j team to accept"
+        ]
+
+testGroupReAddInvited :: IO ()
+testGroupReAddInvited =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      alice ##> "/g team"
+      alice <## "group #team is created"
+      alice <## "use /a team <name> to add members"
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## "use /j team to accept"
+        ]
+      -- alice re-adds bob, he sees it as the same group
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## "use /j team to accept"
+        ]
+      -- if alice removes bob and then re-adds him, she uses a new connection request
+      -- and he sees it as a new group with a different local display name
+      alice ##> "/rm team bob"
+      alice <## "#team: you removed bob from the group"
+      alice ##> "/a team bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "#team_1 (team): alice invites you to join the group as admin"
+            bob <## "use /j team_1 to accept"
+        ]
 
 testGroupRemoveAdd :: IO ()
 testGroupRemoveAdd =
@@ -381,6 +446,36 @@ testGroupRemoveAdd =
         (alice <# "#team cath> hello")
         (bob <# "#team_1 cath> hello")
 
+testGroupList :: IO ()
+testGroupList =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      createGroup2 "team" alice bob
+      alice ##> "/g tennis"
+      alice <## "group #tennis is created"
+      alice <## "use /a tennis <name> to add members"
+      alice ##> "/a tennis bob"
+      concurrentlyN_
+        [ alice <## "invitation to join the group #tennis sent to bob",
+          do
+            bob <## "#tennis: alice invites you to join the group as admin"
+            bob <## "use /j tennis to accept"
+        ]
+      -- alice sees both groups
+      alice ##> "/gs"
+      alice <### ["#team", "#tennis"]
+      -- bob sees #tennis as invitation
+      bob ##> "/gs"
+      bob
+        <### [ "#team",
+               "#tennis - you are invited (/j tennis to join, /d #tennis to delete invitation)"
+             ]
+      -- after deleting invitation bob sees only one group
+      bob ##> "/d #tennis"
+      bob <## "#tennis: you deleted the group"
+      bob ##> "/gs"
+      bob <## "#team"
+
 testUpdateProfile :: IO ()
 testUpdateProfile =
   testChat3 aliceProfile bobProfile cathProfile $
@@ -653,23 +748,27 @@ showName (TestCC ChatController {currentUser} _ _ _ _) = do
   User {localDisplayName, profile = Profile {fullName}} <- readTVarIO currentUser
   pure . T.unpack $ localDisplayName <> " (" <> fullName <> ")"
 
-createGroup3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
-createGroup3 gName cc1 cc2 cc3 = do
+createGroup2 :: String -> TestCC -> TestCC -> IO ()
+createGroup2 gName cc1 cc2 = do
   connectUsers cc1 cc2
-  connectUsers cc1 cc3
   name2 <- userName cc2
-  name3 <- userName cc3
-  sName2 <- showName cc2
-  sName3 <- showName cc3
   cc1 ##> ("/g " <> gName)
   cc1 <## ("group #" <> gName <> " is created")
   cc1 <## ("use /a " <> gName <> " <name> to add members")
-  addMember cc2
+  addMember gName cc1 cc2
   cc2 ##> ("/j " <> gName)
   concurrently_
     (cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group"))
     (cc2 <## ("#" <> gName <> ": you joined the group"))
-  addMember cc3
+
+createGroup3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
+createGroup3 gName cc1 cc2 cc3 = do
+  createGroup2 gName cc1 cc2
+  connectUsers cc1 cc3
+  name3 <- userName cc3
+  sName2 <- showName cc2
+  sName3 <- showName cc3
+  addMember gName cc1 cc3
   cc3 ##> ("/j " <> gName)
   concurrentlyN_
     [ cc1 <## ("#" <> gName <> ": " <> name3 <> " joined the group"),
@@ -680,18 +779,18 @@ createGroup3 gName cc1 cc2 cc3 = do
         cc2 <## ("#" <> gName <> ": alice added " <> sName3 <> " to the group (connecting...)")
         cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected")
     ]
-  where
-    addMember :: TestCC -> IO ()
-    addMember mem = do
-      name1 <- userName cc1
-      memName <- userName mem
-      cc1 ##> ("/a " <> gName <> " " <> memName)
-      concurrentlyN_
-        [ cc1 <## ("invitation to join the group #" <> gName <> " sent to " <> memName),
-          do
-            mem <## ("#" <> gName <> ": " <> name1 <> " invites you to join the group as admin")
-            mem <## ("use /j " <> gName <> " to accept")
-        ]
+
+addMember :: String -> TestCC -> TestCC -> IO ()
+addMember gName inviting invitee = do
+  name1 <- userName inviting
+  memName <- userName invitee
+  inviting ##> ("/a " <> gName <> " " <> memName)
+  concurrentlyN_
+    [ inviting <## ("invitation to join the group #" <> gName <> " sent to " <> memName),
+      do
+        invitee <## ("#" <> gName <> ": " <> name1 <> " invites you to join the group as admin")
+        invitee <## ("use /j " <> gName <> " to accept")
+    ]
 
 -- | test sending direct messages
 (<##>) :: TestCC -> TestCC -> IO ()