Merge branch 'master' into master-ghc8107

2026-05-23 08:56:42 +00:00 · 2023-10-15 18:53:23 +01:00
parent 7692195bfa e6b0983c3e
commit d8fb31f167
30 changed files with 995 additions and 339 deletions
@@ -139,7 +139,8 @@ defaultChatConfig =
      initialCleanupManagerDelay = 30 * 1000000, -- 30 seconds
      cleanupManagerInterval = 30 * 60, -- 30 minutes
      cleanupManagerStepDelay = 3 * 1000000, -- 3 seconds
-      ciExpirationInterval = 30 * 60 * 1000000 -- 30 minutes
+      ciExpirationInterval = 30 * 60 * 1000000, -- 30 minutes
+      coreApi = False
    }

 _defaultSMPServers :: NonEmpty SMPServerWithAuth
@@ -191,6 +192,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
  idsDrg <- newTVarIO =<< liftIO drgNew
  inputQ <- newTBQueueIO tbqSize
  outputQ <- newTBQueueIO tbqSize
+  connNetworkStatuses <- atomically TM.empty
  subscriptionMode <- newTVarIO SMSubscribe
  chatLock <- newEmptyTMVarIO
  sndFiles <- newTVarIO M.empty
@@ -203,6 +205,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
  cleanupManagerAsync <- newTVarIO Nothing
  timedItemThreads <- atomically TM.empty
  showLiveItems <- newTVarIO False
+  encryptLocalFiles <- newTVarIO False
  userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
  tempDirectory <- newTVarIO tempDir
  contactMergeEnabled <- newTVarIO True
@@ -217,6 +220,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
        idsDrg,
        inputQ,
        outputQ,
+        connNetworkStatuses,
        subscriptionMode,
        chatLock,
        sndFiles,
@@ -229,6 +233,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
        cleanupManagerAsync,
        timedItemThreads,
        showLiveItems,
+        encryptLocalFiles,
        userXFTPFileConfig,
        tempDirectory,
        logFilePath = logFile,
@@ -508,6 +513,7 @@ processChatCommand = \case
  APISetXFTPConfig cfg -> do
    asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
    ok_
+  APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_
  SetContactMergeEnabled onOff -> do
    asks contactMergeEnabled >>= atomically . (`writeTVar` onOff)
    ok_
@@ -1080,6 +1086,8 @@ processChatCommand = \case
        user <- getUserByContactId db contactId
        contact <- getContact db user contactId
        pure RcvCallInvitation {user, contact, callType = peerCallType, sharedKey, callTs}
+  APIGetNetworkStatuses -> withUser $ \_ ->
+    CRNetworkStatuses Nothing . map (uncurry ConnNetworkStatus) . M.toList <$> chatReadVar connNetworkStatuses
  APICallStatus contactId receivedStatus ->
    withCurrentCall contactId $ \user ct call ->
      updateCallItemStatus user ct call receivedStatus Nothing $> Just call
@@ -1680,6 +1688,8 @@ processChatCommand = \case
        (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode
        -- [incognito] reuse membership incognito profile
        ct <- withStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode
+        -- TODO not sure it is correct to set connections status here?
+        setContactNetworkStatus ct NSConnected
        pure $ CRNewMemberContact user ct g m
      _ -> throwChatError CEGroupMemberNotActive
  APISendMemberContactInvitation contactId msgContent_ -> withUser $ \user -> do
@@ -1758,19 +1768,16 @@ processChatCommand = \case
  ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
  ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
  SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
-  ReceiveFile fileId encrypted rcvInline_ filePath_ -> withUser $ \_ ->
+  ReceiveFile fileId encrypted_ rcvInline_ filePath_ -> withUser $ \_ ->
    withChatLock "receiveFile" . procCmd $ do
      (user, ft) <- withStore (`getRcvFileTransferById` fileId)
-      ft' <- if encrypted then encryptLocalFile ft else pure ft
+      encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles
+      ft' <- (if encrypt then setFileToEncrypt else pure) ft
      receiveFile' user ft' rcvInline_ filePath_
-    where
-      encryptLocalFile ft = do
-        cfArgs <- liftIO $ CF.randomArgs
-        withStore' $ \db -> setFileCryptoArgs db fileId cfArgs
-        pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs}
-  SetFileToReceive fileId encrypted -> withUser $ \_ -> do
+  SetFileToReceive fileId encrypted_ -> withUser $ \_ -> do
    withChatLock "setFileToReceive" . procCmd $ do
-      cfArgs <- if encrypted then Just <$> liftIO CF.randomArgs else pure Nothing
+      encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles
+      cfArgs <- if encrypt then Just <$> liftIO CF.randomArgs else pure Nothing
      withStore' $ \db -> setRcvFileToReceive db fileId cfArgs
      ok_
  CancelFile fileId -> withUser $ \user@User {userId} ->
@@ -2395,6 +2402,12 @@ toFSFilePath :: ChatMonad' m => FilePath -> m FilePath
 toFSFilePath f =
  maybe f (</> f) <$> (readTVarIO =<< asks filesFolder)

+setFileToEncrypt :: ChatMonad m => RcvFileTransfer -> m RcvFileTransfer
+setFileToEncrypt ft@RcvFileTransfer {fileId} = do
+  cfArgs <- liftIO CF.randomArgs
+  withStore' $ \db -> setFileCryptoArgs db fileId cfArgs
+  pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs}
+
 receiveFile' :: ChatMonad m => User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> m ChatResponse
 receiveFile' user ft rcvInline_ filePath_ = do
  (CRRcvFileAccepted user <$> acceptFileReceive user ft rcvInline_ filePath_) `catchChatError` processError
@@ -2619,6 +2632,7 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do
  rs <- withAgent $ \a -> agentBatchSubscribe a conns
  -- send connection events to view
  contactSubsToView rs cts ce
+-- TODO possibly, we could either disable these events or replace with less noisy for API
  contactLinkSubsToView rs ucs
  groupSubsToView rs gs ms ce
  sndFileSubsToView rs sfts
@@ -2679,12 +2693,30 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do
      let connIds = map aConnId' pcs
      pure (connIds, M.fromList $ zip connIds pcs)
    contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> Bool -> m ()
-    contactSubsToView rs cts ce = do
-      toView . CRContactSubSummary user $ map (uncurry ContactSubStatus) cRs
-      when ce $ mapM_ (toView . uncurry (CRContactSubError user)) cErrors
+    contactSubsToView rs cts ce = ifM (asks $ coreApi . config) notifyAPI notifyCLI
      where
-        cRs = resultsFor rs cts
-        cErrors = sortOn (\(Contact {localDisplayName = n}, _) -> n) $ filterErrors cRs
+        notifyCLI = do
+          let cRs = resultsFor rs cts
+              cErrors = sortOn (\(Contact {localDisplayName = n}, _) -> n) $ filterErrors cRs
+          toView . CRContactSubSummary user $ map (uncurry ContactSubStatus) cRs
+          when ce $ mapM_ (toView . uncurry (CRContactSubError user)) cErrors
+        notifyAPI = do
+          let statuses = M.foldrWithKey' addStatus [] cts
+          chatModifyVar connNetworkStatuses $ M.union (M.fromList statuses)
+          toView $ CRNetworkStatuses (Just user) $ map (uncurry ConnNetworkStatus) statuses
+          where
+            addStatus :: ConnId -> Contact -> [(AgentConnId, NetworkStatus)] -> [(AgentConnId, NetworkStatus)]
+            addStatus connId ct =
+              let ns = (contactAgentConnId ct, netStatus $ resultErr connId rs)
+              in (ns :)
+            netStatus :: Maybe ChatError -> NetworkStatus
+            netStatus = maybe NSConnected $ NSError . errorNetworkStatus
+            errorNetworkStatus :: ChatError -> String
+            errorNetworkStatus = \case
+              ChatErrorAgent (BROKER _ NETWORK) _ -> "network"
+              ChatErrorAgent (SMP SMP.AUTH) _ -> "contact deleted"
+              e -> show e
+-- TODO possibly below could be replaced with less noisy events for API
    contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> m ()
    contactLinkSubsToView rs = toView . CRUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs
    groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> m ()
@@ -2734,12 +2766,12 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do
    resultsFor rs = M.foldrWithKey' addResult []
      where
        addResult :: ConnId -> a -> [(a, Maybe ChatError)] -> [(a, Maybe ChatError)]
-        addResult connId = (:) . (,err)
-          where
-            err = case M.lookup connId rs of
-              Just (Left e) -> Just $ ChatErrorAgent e Nothing
-              Just _ -> Nothing
-              _ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId
+        addResult connId = (:) . (,resultErr connId rs)
+    resultErr :: ConnId -> Map ConnId (Either AgentErrorType ()) -> Maybe ChatError
+    resultErr connId rs = case M.lookup connId rs of
+      Just (Left e) -> Just $ ChatErrorAgent e Nothing
+      Just _ -> Nothing
+      _ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId

 cleanupManager :: forall m. ChatMonad m => m ()
 cleanupManager = do
@@ -2884,16 +2916,22 @@ processAgentMessageNoConn :: forall m. ChatMonad m => ACommand 'Agent 'AENone ->
 processAgentMessageNoConn = \case
  CONNECT p h -> hostEvent $ CRHostConnected p h
  DISCONNECT p h -> hostEvent $ CRHostDisconnected p h
-  DOWN srv conns -> serverEvent srv conns CRContactsDisconnected
-  UP srv conns -> serverEvent srv conns CRContactsSubscribed
+  DOWN srv conns -> serverEvent srv conns NSDisconnected CRContactsDisconnected
+  UP srv conns -> serverEvent srv conns NSConnected CRContactsSubscribed
  SUSPENDED -> toView CRChatSuspended
  DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId
  where
    hostEvent :: ChatResponse -> m ()
    hostEvent = whenM (asks $ hostEvents . config) . toView
-    serverEvent srv conns event = do
-      cs <- withStore' (`getConnectionsContacts` conns)
-      toView $ event srv cs
+    serverEvent srv conns nsStatus event = ifM (asks $ coreApi . config) notifyAPI notifyCLI
+      where
+        notifyAPI = do
+          let connIds = map AgentConnId conns
+          chatModifyVar connNetworkStatuses $ \m -> foldl' (\m' cId -> M.insert cId nsStatus m') m connIds
+          toView $ CRNetworkStatus nsStatus connIds
+        notifyCLI = do
+          cs <- withStore' (`getConnectionsContacts` conns)
+          toView $ event srv cs

 processAgentMsgSndFile :: forall m. ChatMonad m => ACorrId -> SndFileId -> ACommand 'Agent 'AESndFile -> m ()
 processAgentMsgSndFile _corrId aFileId msg =
@@ -3180,6 +3218,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
            Nothing -> do
              -- [incognito] print incognito profile used for this contact
              incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
+              setContactNetworkStatus ct NSConnected
              toView $ CRContactConnected user ct (fmap fromLocalProfile incognitoProfile)
              when (directOrUsed ct) $ createFeatureEnabledItems ct
              when (contactConnInitiated conn) $ do
@@ -3753,6 +3792,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
    notifyMemberConnected :: GroupInfo -> GroupMember -> Maybe Contact -> m ()
    notifyMemberConnected gInfo m ct_ = do
      memberConnectedChatItem gInfo m
+      mapM_ (`setContactNetworkStatus` NSConnected) ct_
      toView $ CRConnectedToGroupMember user gInfo m ct_

    probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> m ()
@@ -3888,14 +3928,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
      inline <- receiveInlineMode fInv (Just mc) fileChunkSize
      ft@RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFT db fInv inline fileChunkSize
      let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
-      (filePath, fileStatus) <- case inline of
+      (filePath, fileStatus, ft') <- case inline of
        Just IFMSent -> do
+          encrypt <- chatReadVar encryptLocalFiles
+          ft' <- (if encrypt then setFileToEncrypt else pure) ft
          fPath <- getRcvFilePath fileId Nothing fileName True
-          withStore' $ \db -> startRcvInlineFT db user ft fPath inline
-          pure (Just fPath, CIFSRcvAccepted)
-        _ -> pure (Nothing, CIFSRcvInvitation)
-      let fileSource = CF.plain <$> filePath
-      pure (ft, CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol})
+          withStore' $ \db -> startRcvInlineFT db user ft' fPath inline
+          pure (Just fPath, CIFSRcvAccepted, ft')
+        _ -> pure (Nothing, CIFSRcvInvitation, ft)
+      let RcvFileTransfer {cryptoArgs} = ft'
+          fileSource = (`CryptoFile` cryptoArgs) <$> filePath
+      pure (ft', CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol})

    messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m ()
    messageUpdate ct@Contact {contactId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do
@@ -5524,6 +5567,7 @@ chatCommandP =
      ("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath),
      "/_xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> jsonP) <|> ("off" $> Nothing))),
      "/xftp " *> (APISetXFTPConfig <$> ("on" *> (Just <$> xftpCfgP) <|> ("off" $> Nothing))),
+      "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP),
      "/contact_merge " *> (SetContactMergeEnabled <$> onOffP),
      "/_db export " *> (APIExportArchive <$> jsonP),
      "/db export" $> ExportArchive,
@@ -5560,6 +5604,7 @@ chatCommandP =
      "/_call end @" *> (APIEndCall <$> A.decimal),
      "/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP),
      "/_call get" $> APIGetCallInvitations,
+      "/_network_statuses" $> APIGetNetworkStatuses,
      "/_profile " *> (APIUpdateProfile <$> A.decimal <* A.space <*> jsonP),
      "/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
      "/_set alias :" *> (APISetConnectionAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
@@ -5699,8 +5744,8 @@ chatCommandP =
      ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal),
      ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal),
      ("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath),
-      ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> (" encrypt=" *> onOffP <|> pure False) <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)),
-      "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> (" encrypt=" *> onOffP <|> pure False)),
+      ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)),
+      "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> optional (" encrypt=" *> onOffP)),
      ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal),
      ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
      "/simplex" *> (ConnectSimplex <$> incognitoP),
@@ -32,6 +32,7 @@ import Data.Char (ord)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Data.String
 import Data.Text (Text)
 import Data.Time (NominalDiffTime, UTCTime)
@@ -124,7 +125,8 @@ data ChatConfig = ChatConfig
    initialCleanupManagerDelay :: Int64,
    cleanupManagerInterval :: NominalDiffTime,
    cleanupManagerStepDelay :: Int64,
-    ciExpirationInterval :: Int64 -- microseconds
+    ciExpirationInterval :: Int64, -- microseconds
+    coreApi :: Bool
  }

 data DefaultAgentServers = DefaultAgentServers
@@ -164,6 +166,7 @@ data ChatController = ChatController
    idsDrg :: TVar ChaChaDRG,
    inputQ :: TBQueue String,
    outputQ :: TBQueue (Maybe CorrId, ChatResponse),
+    connNetworkStatuses :: TMap AgentConnId NetworkStatus,
    subscriptionMode :: TVar SubscriptionMode,
    chatLock :: Lock,
    sndFiles :: TVar (Map Int64 Handle),
@@ -176,6 +179,7 @@ data ChatController = ChatController
    cleanupManagerAsync :: TVar (Maybe (Async ())),
    timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId))),
    showLiveItems :: TVar Bool,
+    encryptLocalFiles :: TVar Bool,
    userXFTPFileConfig :: TVar (Maybe XFTPFileConfig),
    tempDirectory :: TVar (Maybe FilePath),
    logFilePath :: Maybe FilePath,
@@ -218,6 +222,7 @@ data ChatCommand
  | SetTempFolder FilePath
  | SetFilesFolder FilePath
  | APISetXFTPConfig (Maybe XFTPFileConfig)
+  | APISetEncryptLocalFiles Bool
  | SetContactMergeEnabled Bool
  | APIExportArchive ArchiveConfig
  | ExportArchive
@@ -251,6 +256,7 @@ data ChatCommand
  | APIEndCall ContactId
  | APIGetCallInvitations
  | APICallStatus ContactId WebRTCCallStatus
+  | APIGetNetworkStatuses
  | APIUpdateProfile UserId Profile
  | APISetContactPrefs ContactId Preferences
  | APISetContactAlias ContactId LocalAlias
@@ -389,8 +395,8 @@ data ChatCommand
  | ForwardFile ChatName FileTransferId
  | ForwardImage ChatName FileTransferId
  | SendFileDescription ChatName FilePath
-  | ReceiveFile {fileId :: FileTransferId, storeEncrypted :: Bool, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
-  | SetFileToReceive {fileId :: FileTransferId, storeEncrypted :: Bool}
+  | ReceiveFile {fileId :: FileTransferId, storeEncrypted :: Maybe Bool, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
+  | SetFileToReceive {fileId :: FileTransferId, storeEncrypted :: Maybe Bool}
  | CancelFile FileTransferId
  | FileStatus FileTransferId
  | ShowProfile -- UserId (not used in UI)
@@ -528,6 +534,8 @@ data ChatResponse
  | CRContactSubError {user :: User, contact :: Contact, chatError :: ChatError}
  | CRContactSubSummary {user :: User, contactSubscriptions :: [ContactSubStatus]}
  | CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
+  | CRNetworkStatus {networkStatus :: NetworkStatus, connections :: [AgentConnId]}
+  | CRNetworkStatuses {user_ :: Maybe User, networkStatuses :: [ConnNetworkStatus]}
  | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
  | CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
  | CRGroupInvitation {user :: User, groupInfo :: GroupInfo}
@@ -1044,6 +1052,13 @@ chatWriteVar :: ChatMonad' m => (ChatController -> TVar a) -> a -> m ()
 chatWriteVar f value = asks f >>= atomically . (`writeTVar` value)
 {-# INLINE chatWriteVar #-}

+chatModifyVar :: ChatMonad' m => (ChatController -> TVar a) -> (a -> a) -> m ()
+chatModifyVar f newValue = asks f >>= atomically . (`modifyTVar'` newValue)
+{-# INLINE chatModifyVar #-}
+
+setContactNetworkStatus :: ChatMonad' m => Contact -> NetworkStatus -> m ()
+setContactNetworkStatus ct = chatModifyVar connNetworkStatuses . M.insert (contactAgentConnId ct)
+
 tryChatError :: ChatMonad m => m a -> m (Either ChatError a)
 tryChatError = tryAllErrors mkChatError
 {-# INLINE tryChatError #-}
@@ -169,7 +169,8 @@ defaultMobileConfig :: ChatConfig
 defaultMobileConfig =
  defaultChatConfig
    { confirmMigrations = MCYesUp,
-      logLevel = CLLError
+      logLevel = CLLError,
+      coreApi = True
    }

 getActiveUser_ :: SQLiteStore -> IO (Maybe User)
@@ -190,6 +190,9 @@ instance ToJSON Contact where
 contactConn :: Contact -> Connection
 contactConn Contact {activeConn} = activeConn

+contactAgentConnId :: Contact -> AgentConnId
+contactAgentConnId Contact {activeConn = Connection {agentConnId}} = agentConnId
+
 contactConnId :: Contact -> ConnId
 contactConnId = aConnId . contactConn

@@ -1138,13 +1141,16 @@ liveRcvFileTransferPath ft = fp <$> liveRcvFileTransferInfo ft
    fp RcvFileInfo {filePath} = filePath

 newtype AgentConnId = AgentConnId ConnId
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)

 instance StrEncoding AgentConnId where
  strEncode (AgentConnId connId) = strEncode connId
  strDecode s = AgentConnId <$> strDecode s
  strP = AgentConnId <$> strP

+instance FromJSON AgentConnId where
+  parseJSON = strParseJSON "AgentConnId"
+
 instance ToJSON AgentConnId where
  toJSON = strToJSON
  toEncoding = strToJEncoding
@@ -1475,6 +1481,35 @@ serializeIntroStatus = \case
 textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a
 textParseJSON name = J.withText name $ maybe (fail $ "bad " <> name) pure . textDecode

+data NetworkStatus
+  = NSUnknown
+  | NSConnected
+  | NSDisconnected
+  | NSError {connectionError :: String}
+  deriving (Eq, Ord, Show, Generic)
+
+netStatusStr :: NetworkStatus -> String
+netStatusStr = \case
+  NSUnknown -> "unknown"
+  NSConnected -> "connected"
+  NSDisconnected -> "disconnected"
+  NSError e -> "error: " <> e
+
+instance FromJSON NetworkStatus where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "NS"
+
+instance ToJSON NetworkStatus where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "NS"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "NS"
+
+data ConnNetworkStatus = ConnNetworkStatus
+  { agentConnId :: AgentConnId,
+    networkStatus :: NetworkStatus
+  }
+  deriving (Show, Generic, FromJSON)
+
+instance ToJSON ConnNetworkStatus where toEncoding = J.genericToEncoding J.defaultOptions
+
 type CommandId = Int64

 aCorrId :: CommandId -> ACorrId
@@ -18,7 +18,7 @@ import Data.Char (isSpace, toUpper)
 import Data.Function (on)
 import Data.Int (Int64)
 import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -165,7 +165,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
  CRRcvFileDescrReady _ _ -> []
  CRRcvFileDescrNotReady _ _ -> []
  CRRcvFileProgressXFTP {} -> []
-  CRRcvFileAccepted u ci -> ttyUser u $ savingFile' testView ci
+  CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
  CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
  CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts
  CRRcvFileCancelled u _ ft -> ttyUser u $ receivingFile_ "cancelled" ft
@@ -177,10 +177,10 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
  CRContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
  CRContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
  CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
-  CRRcvFileStart u ci -> ttyUser u $ receivingFile_' "started" ci
-  CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' "completed" ci
+  CRRcvFileStart u ci -> ttyUser u $ receivingFile_' testView "started" ci
+  CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' testView "completed" ci
  CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
-  CRRcvFileError u ci e -> ttyUser u $ receivingFile_' "error" ci <> [sShow e]
+  CRRcvFileError u ci e -> ttyUser u $ receivingFile_' testView "error" ci <> [sShow e]
  CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
  CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
  CRSndFileStartXFTP {} -> []
@@ -209,6 +209,8 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
      (addresses, groupLinks) = partition (\UserContactSubStatus {userContact} -> isNothing . userContactGroupId $ userContact) summary
      addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError
      (groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
+  CRNetworkStatus status conns -> if testView then [plain $ show (length conns) <> " connections " <> netStatusStr status] else []
+  CRNetworkStatuses u statuses -> if testView then ttyUser' u $ viewNetworkStatuses statuses else []
  CRGroupInvitation u g -> ttyUser u [groupInvitation' g]
  CRReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g c r
  CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
@@ -797,6 +799,12 @@ viewDirectMessagesProhibited :: MsgDirection -> Contact -> [StyledString]
 viewDirectMessagesProhibited MDSnd c = ["direct messages to indirect contact " <> ttyContact' c <> " are prohibited"]
 viewDirectMessagesProhibited MDRcv c = ["received prohibited direct message from indirect contact " <> ttyContact' c <> " (discarded)"]

+viewNetworkStatuses :: [ConnNetworkStatus] -> [StyledString]
+viewNetworkStatuses = map viewStatuses . L.groupBy ((==) `on` netStatus) . sortOn netStatus
+  where
+    netStatus ConnNetworkStatus {networkStatus} = networkStatus
+    viewStatuses ss@(s :| _) = plain $ show (L.length ss) <> " connections " <> netStatusStr (netStatus s)
+
 viewUserJoinedGroup :: GroupInfo -> [StyledString]
 viewUserJoinedGroup g =
  case incognitoMembershipProfile g of
@@ -1438,27 +1446,28 @@ humanReadableSize size
    mB = kB * 1024
    gB = mB * 1024

-savingFile' :: Bool -> AChatItem -> [StyledString]
-savingFile' testView (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource = Just (CryptoFile filePath cfArgs_)}, chatDir}) =
-  let from = case (chat, chatDir) of
-        (DirectChat Contact {localDisplayName = c}, CIDirectRcv) -> " from " <> ttyContact c
-        (_, CIGroupRcv GroupMember {localDisplayName = m}) -> " from " <> ttyContact m
-        _ -> ""
-   in ["saving file " <> sShow fileId <> from <> " to " <> plain filePath] <> cfArgsStr
-  where
-    cfArgsStr = case cfArgs_ of
-      Just cfArgs@(CFArgs key nonce)
-        | testView -> [plain $ LB.unpack $ J.encode cfArgs]
-        | otherwise -> [plain $ "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce]
-      _ -> []
-savingFile' _ _ = ["saving file"] -- shouldn't happen
+savingFile' :: AChatItem -> [StyledString]
+savingFile' (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource = Just (CryptoFile filePath _)}, chatDir}) =
+  ["saving file " <> sShow fileId <> fileFrom chat chatDir <> " to " <> plain filePath]
+savingFile' _ = ["saving file"] -- shouldn't happen

-receivingFile_' :: StyledString -> AChatItem -> [StyledString]
-receivingFile_' status (AChatItem _ _ (DirectChat c) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectRcv}) =
-  [status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact' c]
-receivingFile_' status (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupRcv m}) =
-  [status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyMember m]
-receivingFile_' status _ = [status <> " receiving file"] -- shouldn't happen
+receivingFile_' :: Bool -> String -> AChatItem -> [StyledString]
+receivingFile_' testView status (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileName, fileSource = Just (CryptoFile _ cfArgs_)}, chatDir}) =
+  [plain status <> " receiving " <> fileTransferStr fileId fileName <> fileFrom chat chatDir] <> cfArgsStr cfArgs_
+  where
+    cfArgsStr (Just cfArgs@(CFArgs key nonce)) = [plain s | status == "completed"]
+      where
+      s =
+        if testView
+          then LB.toStrict $ J.encode cfArgs
+          else "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce
+    cfArgsStr _ = []
+receivingFile_' _ status _ = [plain status <> " receiving file"] -- shouldn't happen
+
+fileFrom :: ChatInfo c -> CIDirection c d -> StyledString
+fileFrom (DirectChat ct) CIDirectRcv = " from " <> ttyContact' ct
+fileFrom _ (CIGroupRcv m) = " from " <> ttyMember m
+fileFrom _ _ = ""

 receivingFile_ :: StyledString -> RcvFileTransfer -> [StyledString]
 receivingFile_ status ft@RcvFileTransfer {senderDisplayName = c} =