asynchronously subscribe to user connections (#310)

* asynchronously subscribe to user connections

* send subscription status summaries to view/api

* refactor

* add help messages in summaries

* update simplexmq

* rename config field

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

src/Simplex/Chat/Controller.hs

@@ -50,6 +50,7 @@ data ChatConfig = ChatConfig
     yesToMigrations :: Bool,
     tbqSize :: Natural,
     fileChunkSize :: Integer,
+    subscriptionEvents :: Bool,
     testView :: Bool
   }
 
@@ -186,6 +187,7 @@ data ChatResponse
   | CRContactDisconnected {contact :: Contact}
   | CRContactSubscribed {contact :: Contact}
   | CRContactSubError {contact :: Contact, chatError :: ChatError}
+  | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
   | CRGroupInvitation {groupInfo :: GroupInfo}
   | CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
   | CRUserJoinedGroup {groupInfo :: GroupInfo}
@@ -199,6 +201,7 @@ data ChatResponse
   | CRGroupRemoved {groupInfo :: GroupInfo}
   | CRGroupDeleted {groupInfo :: GroupInfo, member :: GroupMember}
   | CRMemberSubError {groupInfo :: GroupInfo, contactName :: ContactName, chatError :: ChatError} -- TODO Contact?  or GroupMember?
+  | CRMemberSubErrors {memberSubErrors :: [MemberSubError]}
   | CRGroupSubscribed {groupInfo :: GroupInfo}
   | CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
   | CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
@@ -213,6 +216,25 @@ instance ToJSON ChatResponse where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
 
+data ContactSubStatus = ContactSubStatus
+  { contact :: Contact,
+    contactError :: Maybe ChatError
+  }
+  deriving (Show, Generic)
+
+instance ToJSON ContactSubStatus where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+data MemberSubError = MemberSubError
+  { member :: GroupMember,
+    memberError :: ChatError
+  }
+  deriving (Show, Generic)
+
+instance ToJSON MemberSubError where
+  toEncoding = J.genericToEncoding J.defaultOptions
+
 data ChatError
   = ChatError {errorType :: ChatErrorType}
   | ChatErrorAgent {agentError :: AgentErrorType}

src/Simplex/Chat/Mobile.hs

@@ -49,7 +49,8 @@ mobileChatOpts =
   ChatOpts
     { dbFilePrefix = "simplex_v1", -- two database files will be created: simplex_v1_chat.db and simplex_v1_agent.db
       smpServers = defaultSMPServers,
-      logging = False
+      logConnections = False,
+      logAgent = False
     }
 
 defaultMobileConfig :: ChatConfig

src/Simplex/Chat/Options.hs

@@ -21,7 +21,8 @@ import System.FilePath (combine)
 data ChatOpts = ChatOpts
   { dbFilePrefix :: String,
     smpServers :: NonEmpty SMPServer,
-    logging :: Bool
+    logConnections :: Bool,
+    logAgent :: Bool
   }
 
 defaultSMPServers :: NonEmpty SMPServer
@@ -55,9 +56,14 @@ chatOpts appDir =
           <> value defaultSMPServers
       )
     <*> switch
-      ( long "log"
+      ( long "connections"
+          <> short 'c'
+          <> help "Log every contact and group connection on start"
+      )
+    <*> switch
+      ( long "log-agent"
           <> short 'l'
-          <> help "Enable logging"
+          <> help "Enable logs from SMP agent"
       )
   where
     defaultDbFilePath = combine appDir "simplex_v1"

src/Simplex/Chat/Terminal.hs

@@ -20,7 +20,7 @@ import UnliftIO (async, waitEither_)
 
 simplexChat :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
 simplexChat cfg@ChatConfig {dbPoolSize, yesToMigrations} opts t
-  | logging opts = do
+  | logAgent opts = do
     setLogLevel LogInfo -- LogError
     withGlobalLogging logCfg initRun
   | otherwise = initRun

src/Simplex/Chat/View.hs

@@ -10,7 +10,8 @@ module Simplex.Chat.View where
 import qualified Data.Aeson as J
 import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (groupBy, intersperse, sortOn)
+import Data.List (groupBy, intersperse, partition, sortOn)
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (DiffTime)
@@ -101,6 +102,10 @@ responseToView testView = \case
   CRContactDisconnected c -> [ttyContact' c <> ": disconnected from server (messages will be queued)"]
   CRContactSubscribed c -> [ttyContact' c <> ": connected to server"]
   CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e]
+  CRContactSubSummary summary ->
+    (if null connected then [] else [sShow (length connected) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)"]) <> viewErrorsSummary errors " contact errors"
+    where
+      (errors, connected) = partition (isJust . contactError) summary
   CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} ->
     [groupInvitation ldn fullName]
   CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role
@@ -115,6 +120,7 @@ responseToView testView = \case
   CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"]
   CRGroupDeleted g m -> [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
   CRMemberSubError g c e -> [ttyGroup' g <> " member " <> ttyContact c <> " error: " <> sShow e]
+  CRMemberSubErrors summary -> viewErrorsSummary summary " group member errors"
   CRGroupSubscribed g -> [ttyFullGroup g <> ": connected to server(s)"]
   CRSndFileSubError SndFileTransfer {fileId, fileName} e ->
     ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
@@ -140,6 +146,8 @@ responseToView testView = \case
       where
         toChatView :: CChatItem c -> (Int, Text)
         toChatView (CChatItem dir ChatItem {meta}) = (msgDirectionInt $ toMsgDirection dir, itemText meta)
+    viewErrorsSummary :: [a] -> StyledString -> [StyledString]
+    viewErrorsSummary summary s = if null summary then [] else [styled (colored Red) (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)"]
 
 viewChatItem :: ChatInfo c -> ChatItem c d -> [StyledString]
 viewChatItem chat (ChatItem cd meta content _) = case (chat, cd) of