core: host connection events

cabal.project

@@ -5,7 +5,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 68138c08d29ba27cbf23a29cf9c2ab6653173685
+    tag: 02bba01c1661e59b5bf6e443d759ca601ffa1cd8
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."68138c08d29ba27cbf23a29cf9c2ab6653173685" = "0b9yhbd3jsrbfnf1asvi2wwyqy65fq31h1f76s6sx5rcyir33ibb";
+  "https://github.com/simplex-chat/simplexmq.git"."02bba01c1661e59b5bf6e443d759ca601ffa1cd8" = "1ziryv40jg0w32yv122xn8s9c6xijzahw1dzwyzi1s1sv9016nhm";
   "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
   "https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
   "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97";

src/Simplex/Chat.hs

@@ -99,6 +99,7 @@ defaultChatConfig =
       fileChunkSize = 15780,
       subscriptionConcurrency = 16,
       subscriptionEvents = False,
+      hostEvents = False,
       testView = False
     }
 
@@ -123,9 +124,9 @@ logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 newChatController :: SQLiteStore -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController
-newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers} ChatOpts {dbFilePrefix, smpServers, networkConfig, logConnections} sendToast = do
+newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers} ChatOpts {dbFilePrefix, smpServers, networkConfig, logConnections, logServerHosts} sendToast = do
   let f = chatStoreFile dbFilePrefix
-      config = cfg {subscriptionEvents = logConnections}
+      config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts}
       sendNotification = fromMaybe (const $ pure ()) sendToast
   activeTo <- newTVarIO ActiveNone
   firstTime <- not <$> doesFileExist f
@@ -1247,11 +1248,14 @@ subscribeUserConnections agentBatchSubscribe user = do
 processAgentMessage :: forall m. ChatMonad m => Maybe User -> ConnId -> ACommand 'Agent -> m ()
 processAgentMessage Nothing _ _ = throwChatError CENoActiveUser
 processAgentMessage (Just User {userId}) "" agentMessage = case agentMessage of
+  CONNECT p h -> hostEvent $ CRHostConnected p h
+  DISCONNECT p h -> hostEvent $ CRHostDisconnected p h
   DOWN srv conns -> serverEvent srv conns CRContactsDisconnected "disconnected"
   UP srv conns -> serverEvent srv conns CRContactsSubscribed "connected"
   SUSPENDED -> toView CRChatSuspended
   _ -> pure ()
   where
+    hostEvent = whenM (asks $ hostEvents . config) . toView
     serverEvent srv@(SMPServer host _ _) conns event str = do
       cs <- withStore' $ \db -> getConnectionsContacts db userId conns
       toView $ event srv cs

src/Simplex/Chat/Controller.hs

@@ -40,8 +40,9 @@ import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
-import Simplex.Messaging.Protocol (CorrId, MsgFlags)
+import Simplex.Messaging.Protocol (AProtocolType, CorrId, MsgFlags)
 import Simplex.Messaging.TMap (TMap)
+import Simplex.Messaging.Transport.Client (TransportHost)
 import System.IO (Handle)
 import UnliftIO.STM
 
@@ -62,6 +63,7 @@ data ChatConfig = ChatConfig
     fileChunkSize :: Integer,
     subscriptionConcurrency :: Int,
     subscriptionEvents :: Bool,
+    hostEvents :: Bool,
     testView :: Bool
   }
 
@@ -269,6 +271,8 @@ data ChatResponse
   | CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
   | CRContactSubError {contact :: Contact, chatError :: ChatError}
   | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
+  | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
+  | CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
   | CRGroupInvitation {groupInfo :: GroupInfo}
   | CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
   | CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember}

src/Simplex/Chat/Mobile.hs

@@ -70,6 +70,7 @@ mobileChatOpts =
       smpServers = [],
       networkConfig = defaultNetworkConfig,
       logConnections = False,
+      logServerHosts = True,
       logAgent = False,
       chatCmd = "",
       chatCmdDelay = 3,

src/Simplex/Chat/Options.hs

@@ -28,6 +28,7 @@ data ChatOpts = ChatOpts
     smpServers :: [SMPServer],
     networkConfig :: NetworkConfig,
     logConnections :: Bool,
+    logServerHosts :: Bool,
     logAgent :: Bool,
     chatCmd :: String,
     chatCmdDelay :: Int,
@@ -56,12 +57,12 @@ chatOpts appDir defaultDbFileName = do
           <> value []
       )
   socksProxy <-
-    flag' (Just defaultSocksProxy) (short 'x' <> help "use local SOCKS5 proxy at :9050")
+    flag' (Just defaultSocksProxy) (short 'x' <> help "Use local SOCKS5 proxy at :9050")
       <|> option
         parseSocksProxy
         ( long "socks-proxy"
             <> metavar "SOCKS5"
-            <> help "`ipv4:port` or `:port` of SOCKS5 proxy"
+            <> help "Use SOCKS5 proxy at `ipv4:port` or `:port`"
             <> value Nothing
         )
   t <-
@@ -78,10 +79,15 @@ chatOpts appDir defaultDbFileName = do
           <> short 'c'
           <> help "Log every contact and group connection on start"
       )
+  logServerHosts <-
+    switch
+      ( long "log-hosts"
+          <> short 'l'
+          <> help "Log connections to servers"
+      )
   logAgent <-
     switch
       ( long "log-agent"
-          <> short 'l'
           <> help "Enable logs from SMP agent"
       )
   chatCmd <-
@@ -123,6 +129,7 @@ chatOpts appDir defaultDbFileName = do
         smpServers,
         networkConfig = fullNetworkConfig socksProxy $ useTcpTimeout socksProxy t,
         logConnections,
+        logServerHosts,
         logAgent,
         chatCmd,
         chatCmdDelay,

src/Simplex/Chat/View.hs

@@ -14,6 +14,7 @@ import Data.Aeson (ToJSON)
 import qualified Data.Aeson as J
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Char (toUpper)
 import Data.Function (on)
 import Data.Int (Int64)
 import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
@@ -42,8 +43,9 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
-import Simplex.Messaging.Protocol (ProtocolServer (..))
+import Simplex.Messaging.Protocol (AProtocolType, ProtocolServer (..))
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (bshow)
 import System.Console.ANSI.Types
 
@@ -136,6 +138,8 @@ responseToView testView = \case
     [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
     where
       (errors, subscribed) = partition (isJust . contactError) summary
+  CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h]
+  CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h]
   CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} ->
     [groupInvitation' ldn fullName]
   CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role
@@ -207,6 +211,9 @@ responseToView testView = \case
 showSMPServer :: SMPServer -> String
 showSMPServer = B.unpack . strEncode . host
 
+viewHostEvent :: AProtocolType -> TransportHost -> String
+viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h)
+
 viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> [StyledString]
 viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = case chat of
   DirectChat c -> case chatDir of
@@ -863,6 +870,8 @@ viewChatError = \case
         \ secured with different credentials, or due to a bug - please re-create the connection"
       ]
     AGENT A_DUPLICATE -> []
+    AGENT A_PROHIBITED -> []
+    CONN NOT_FOUND -> []
     e -> ["smp agent error: " <> sShow e]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 68138c08d29ba27cbf23a29cf9c2ab6653173685
+    commit: 02bba01c1661e59b5bf6e443d759ca601ffa1cd8
   # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
   - github: simplex-chat/aeson
     commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7

tests/ChatClient.hs

@@ -51,6 +51,7 @@ testOpts =
       smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
       networkConfig = defaultNetworkConfig,
       logConnections = False,
+      logServerHosts = False,
       logAgent = False,
       chatCmd = "",
       chatCmdDelay = 3,