core: servers summary api (#4319)

* core: servers summary api * rework * server known types * set stats file path * rename * local simplexmq * update * rfc * update * update * get servers * compile summary * remove sort * rename * rename, refactor * refactor attempt * refactor attempt 2 * refactor * fix * fix2 * remove space * refactor xftp * update --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
2024-12-17 17:20:21 +01:00 · 2024-06-25 09:51:55 +04:00
parent 1af513c548
commit d951003191
18 changed files with 432 additions and 35 deletions
@@ -20,6 +20,7 @@ import Control.Applicative (optional, (<|>))
 import Control.Concurrent.STM (retry)
 import Control.Logger.Simple
 import Control.Monad
+import Simplex.Chat.Stats
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
@@ -84,7 +85,6 @@ import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
-import Simplex.Chat.Types.Util
 import Simplex.Chat.Util (encryptFile, liftIOEither, shuffle)
 import qualified Simplex.Chat.Util as U
 import Simplex.FileTransfer.Client.Main (maxFileSize, maxFileSizeHard)
@@ -113,7 +113,7 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (base64P)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolTypeI, SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolTypeI, SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol, ProtocolServer)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
@@ -369,7 +369,7 @@ activeAgentServers ChatConfig {defaultServers} p =
  fromMaybe (cfgServers p defaultServers)
    . nonEmpty
    . map (\ServerCfg {server} -> server)
-    . filter (\ServerCfg {enabled} -> enabled)
+    . filter (\ServerCfg {enabled} -> enabled == SEEnabled)

 cfgServers :: UserProtocol p => SProtocolType p -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p))
 cfgServers p DefaultAgentServers {smp, xftp} = case p of
@@ -1315,7 +1315,7 @@ processChatCommand' vr = \case
        servers' = fromMaybe (L.map toServerCfg defServers) $ nonEmpty servers
    pure $ CRUserProtoServers user $ AUPS $ UserProtoServers p servers' defServers
    where
-      toServerCfg server = ServerCfg {server, preset = True, tested = Nothing, enabled = True}
+      toServerCfg server = ServerCfg {server, preset = True, tested = Nothing, enabled = SEEnabled}
  GetUserProtoServers aProtocol -> withUser $ \User {userId} ->
    processChatCommand $ APIGetUserProtoServers userId aProtocol
  APISetUserProtoServers userId (APSC p (ProtoServersConfig servers)) -> withUserId userId $ \user -> withServerProtocol p $ do
@@ -2253,6 +2253,21 @@ processChatCommand' vr = \case
        CLUserContact ucId -> "UserContact " <> show ucId
        CLFile fId -> "File " <> show fId
  DebugEvent event -> toView event >> ok_
+  GetAgentServersSummary userId -> withUserId userId $ \user -> do
+    agentServersSummary <- lift $ withAgent' getAgentServersSummary
+    users <- withStore' getUsers
+    smpServers <- getUserServers user SPSMP
+    xftpServers <- getUserServers user SPXFTP
+    let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers
+    pure $ CRAgentServersSummary user presentedServersSummary
+    where
+      getUserServers :: forall p. (ProtocolTypeI p, UserProtocol p) => User -> SProtocolType p -> CM [ProtocolServer p]
+      getUserServers users protocol = do
+        ChatConfig {defaultServers} <- asks config
+        let defServers = cfgServers protocol defaultServers
+        servers <- map (\ServerCfg {server} -> server) <$> withStore' (`getProtocolServers` users)
+        let srvs = if null servers then L.toList defServers else servers
+        pure $ map protoServer srvs
  GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary
  GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails
  GetAgentStats -> lift $ CRAgentStats . map stat <$> withAgent' getAgentStats
@@ -7611,6 +7626,7 @@ chatCommandP =
      ("/version" <|> "/v") $> ShowVersion,
      "/debug locks" $> DebugLocks,
      "/debug event " *> (DebugEvent <$> jsonP),
+      "/get servers summary " *> (GetAgentServersSummary <$> A.decimal),
      "/get stats" $> GetAgentStats,
      "/reset stats" $> ResetAgentStats,
      "/get subs" $> GetAgentSubs,
@@ -7755,7 +7771,7 @@ chatCommandP =
        (Just <$> (AutoAccept <$> (" incognito=" *> onOffP <|> pure False) <*> optional (A.space *> msgContentP)))
        (pure Nothing)
    srvCfgP = strP >>= \case AProtocolType p -> APSC p <$> (A.space *> jsonP)
-    toServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
+    toServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = SEEnabled}
    rcCtrlAddressP = RCCtrlAddress <$> ("addr=" *> strP) <*> (" iface=" *> (jsonP <|> text1P))
    text1P = safeDecodeUtf8 <$> A.takeTill (== ' ')
    char_ = optional . A.char
@@ -21,10 +21,10 @@ import Data.Time.Clock (UTCTime)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Chat.Types (Contact, ContactId, User)
-import Simplex.Chat.Types.Util (decodeJSON, encodeJSON)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
+import Simplex.Messaging.Util (decodeJSON, encodeJSON)

 data Call = Call
  { contactId :: ContactId,
@@ -60,6 +60,7 @@ import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.AppVersion
 import Simplex.Chat.Remote.Types
+import Simplex.Chat.Stats (PresentedServersSummary)
 import Simplex.Chat.Store (AutoAccept, ChatLockEntity, StoreError (..), UserContactLink, UserMsgReceiptSettings)
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -75,7 +76,7 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction)
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import Simplex.Messaging.Client (SMPProxyMode (..), SMPProxyFallback (..))
+import Simplex.Messaging.Client (SMPProxyFallback (..), SMPProxyMode (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -505,6 +506,7 @@ data ChatCommand
  | ShowVersion
  | DebugLocks
  | DebugEvent ChatResponse
+  | GetAgentServersSummary UserId
  | GetAgentStats
  | ResetAgentStats
  | GetAgentSubs
@@ -756,6 +758,7 @@ data ChatResponse
  | CRSQLResult {rows :: [Text]}
  | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
  | CRDebugLocks {chatLockName :: Maybe String, chatEntityLocks :: Map String String, agentLocks :: AgentLocks}
+  | CRAgentServersSummary {user :: User, serversSummary :: PresentedServersSummary}
  | CRAgentStats {agentStats :: [[String]]}
  | CRAgentWorkersDetails {agentWorkersDetails :: AgentWorkersDetails}
  | CRAgentWorkersSummary {agentWorkersSummary :: AgentWorkersSummary}
@@ -29,13 +29,12 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Simplex.Chat.Types
-import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ConnReqUriData (..), ConnectionRequestUri (..), SMPQueue (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, sumTypeJSON)
 import Simplex.Messaging.Protocol (ProtocolServer (..))
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
-import Simplex.Messaging.Util (safeDecodeUtf8)
+import Simplex.Messaging.Util (decodeJSON, safeDecodeUtf8)
 import System.Console.ANSI.Types
 import qualified Text.Email.Validate as Email

@@ -146,7 +145,7 @@ parseMarkdown s = fromRight (unmarked s) $ A.parseOnly (markdownP <* A.endOfInpu

 isSimplexLink :: Format -> Bool
 isSimplexLink = \case
-  SimplexLink {} -> True;
+  SimplexLink {} -> True
  _ -> False

 markdownP :: Parser Markdown
@@ -29,12 +29,11 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
-import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..))
-import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOn, pattern PQEncOff)
+import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOff, pattern PQEncOn)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)
-import Simplex.Messaging.Util (safeDecodeUtf8, tshow, (<$?>))
+import Simplex.Messaging.Util (encodeJSON, safeDecodeUtf8, tshow, (<$?>))

 data MsgDirection = MDRcv | MDSnd
  deriving (Eq, Show)
@@ -46,14 +46,13 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Chat.Call
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Shared
-import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion)
 import Simplex.Messaging.Compression (Compressed, compress1, decompress1)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
 import Simplex.Messaging.Protocol (MsgBody)
-import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
+import Simplex.Messaging.Util (decodeJSON, eitherToMaybe, encodeJSON, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version hiding (version)

 -- Chat version history:
@@ -0,0 +1,268 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
+module Simplex.Chat.Stats where
+
+import Control.Applicative ((<|>))
+import qualified Data.Aeson.TH as J
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Maybe (fromMaybe, isJust)
+import Data.Time.Clock (UTCTime)
+import Simplex.Chat.Types
+import Simplex.Messaging.Agent.Client
+import Simplex.Messaging.Agent.Protocol (UserId)
+import Simplex.Messaging.Agent.Stats
+import Simplex.Messaging.Parsers (defaultJSON)
+import Simplex.Messaging.Protocol
+
+data PresentedServersSummary = PresentedServersSummary
+  { statsStartedAt :: UTCTime,
+    currentUserServers :: ServersSummary,
+    allUsersServers :: ServersSummary
+  }
+  deriving (Show)
+
+-- Presentation of servers will be split into separate categories,
+-- so users can differentiate currently used (connected) servers,
+-- previously connected servers that were in use in previous sessions,
+-- and servers that are only proxied (not connected directly).
+data ServersSummary = ServersSummary
+  { -- currently used SMP servers are those with Just in sessions and/or subs in SMPServerSummary;
+    -- all other servers would fall either into previously used or only proxied servers category
+    currentlyUsedSMPServers :: [SMPServerSummary],
+    -- previously used SMP servers are those with Nothing in sessions and subs,
+    -- and have any of sentDirect, sentProxied, recvMsgs, etc. > 0 in server stats (see toPresentedServersSummary);
+    -- remaining servers would fall into only proxied servers category
+    previouslyUsedSMPServers :: [SMPServerSummary],
+    -- only proxied SMP servers are those that aren't (according to current state - sessions and subs)
+    -- and weren't (according to stats) connected directly; they would have Nothing in sessions and subs,
+    -- and have all of sentDirect, sentProxied, recvMsgs, etc. = 0 in server stats
+    onlyProxiedSMPServers :: [SMPServerSummary],
+    -- currently used XFTP servers are those with Just in sessions in XFTPServerSummary,
+    -- and/or have upload/download/deletion in progress;
+    -- all other servers would fall into previously used servers category
+    currentlyUsedXFTPServers :: [XFTPServerSummary],
+    -- previously used XFTP servers are those with Nothing in sessions and don't have any process in progress
+    previouslyUsedXFTPServers :: [XFTPServerSummary]
+  }
+  deriving (Show)
+
+data SMPServerSummary = SMPServerSummary
+  { smpServer :: SMPServer,
+    -- known:
+    -- for simplicity always Nothing in totalServersSummary - allows us to load configured servers only for current user,
+    -- and also unnecessary unless we want to add navigation to other users servers settings;
+    -- always Just in currentUserServers - True if server is in list of user servers, otherwise False;
+    -- True - allows to navigate to server settings, False - allows to add server to configured as known (SEKnown)
+    known :: Maybe Bool,
+    sessions :: Maybe ServerSessions,
+    subs :: Maybe SMPServerSubs,
+    -- stats:
+    -- even if sessions and subs are Nothing, stats can be Just - server could be used earlier in session,
+    -- or in previous sessions and stats for it were restored; server would fall into a category of
+    -- previously used or only proxied servers - see ServersSummary above
+    stats :: Maybe AgentSMPServerStatsData
+  }
+  deriving (Show)
+
+data XFTPServerSummary = XFTPServerSummary
+  { xftpServer :: XFTPServer,
+    known :: Maybe Bool, -- same as for SMPServerSummary
+    sessions :: Maybe ServerSessions,
+    stats :: Maybe AgentXFTPServerStatsData,
+    rcvInProgress :: Bool,
+    sndInProgress :: Bool,
+    delInProgress :: Bool
+  }
+  deriving (Show)
+
+-- Maps AgentServersSummary to PresentedServersSummary:
+-- - currentUserServers is for currentUser;
+-- - users are passed to exclude hidden users from totalServersSummary;
+-- - if currentUser is hidden, it should be accounted in totalServersSummary;
+-- - known is set only in user level summaries based on passed userSMPSrvs and userXFTPSrvs
+toPresentedServersSummary :: AgentServersSummary -> [User] -> User -> [SMPServer] -> [XFTPServer] -> PresentedServersSummary
+toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrvs = do
+  let (userSMPSrvsSumms, allSMPSrvsSumms) = accSMPSrvsSummaries
+      (userSMPCurr, userSMPPrev, userSMPProx) = smpSummsIntoCategories userSMPSrvsSumms
+      (allSMPCurr, allSMPPrev, allSMPProx) = smpSummsIntoCategories allSMPSrvsSumms
+      (userXFTPSrvsSumms, allXFTPSrvsSumms) = accXFTPSrvsSummaries
+      (userXFTPCurr, userXFTPPrev) = xftpSummsIntoCategories userXFTPSrvsSumms
+      (allXFTPCurr, allXFTPPrev) = xftpSummsIntoCategories allXFTPSrvsSumms
+  PresentedServersSummary
+    { statsStartedAt,
+      currentUserServers =
+        ServersSummary
+          { currentlyUsedSMPServers = userSMPCurr,
+            previouslyUsedSMPServers = userSMPPrev,
+            onlyProxiedSMPServers = userSMPProx,
+            currentlyUsedXFTPServers = userXFTPCurr,
+            previouslyUsedXFTPServers = userXFTPPrev
+          },
+      allUsersServers =
+        ServersSummary
+          { currentlyUsedSMPServers = allSMPCurr,
+            previouslyUsedSMPServers = allSMPPrev,
+            onlyProxiedSMPServers = allSMPProx,
+            currentlyUsedXFTPServers = allXFTPCurr,
+            previouslyUsedXFTPServers = allXFTPPrev
+          }
+    }
+  where
+    AgentServersSummary {statsStartedAt, smpServersSessions, smpServersSubs, smpServersStats, xftpServersSessions, xftpServersStats, xftpRcvInProgress, xftpSndInProgress, xftpDelInProgress} = agentSummary
+    countUserInAll auId = auId == aUserId currentUser || auId `notElem` hiddenUserIds
+    hiddenUserIds = map aUserId $ filter (isJust . viewPwdHash) users
+    smpSummsIntoCategories :: Map SMPServer SMPServerSummary -> ([SMPServerSummary], [SMPServerSummary], [SMPServerSummary])
+    smpSummsIntoCategories = foldr partitionSummary ([], [], [])
+      where
+        partitionSummary srvSumm (curr, prev, prox)
+          | isCurrentlyUsed srvSumm = (srvSumm : curr, prev, prox)
+          | isPreviouslyUsed srvSumm = (curr, srvSumm : prev, prox)
+          | otherwise = (curr, prev, srvSumm : prox)
+        isCurrentlyUsed SMPServerSummary {sessions, subs} = isJust sessions || isJust subs
+        isPreviouslyUsed SMPServerSummary {stats} = case stats of
+          Nothing -> False
+          -- add connCompleted, connDeleted?
+          -- check: should connCompleted be counted for proxy? is it?
+          Just AgentSMPServerStatsData {_sentDirect, _sentProxied, _sentDirectAttempts, _sentProxiedAttempts, _recvMsgs, _connCreated, _connSecured, _connSubscribed, _connSubAttempts} ->
+            _sentDirect > 0 || _sentProxied > 0 || _sentDirectAttempts > 0 || _sentProxiedAttempts > 0 || _recvMsgs > 0 || _connCreated > 0 || _connSecured > 0 || _connSubscribed > 0 || _connSubAttempts > 0
+    xftpSummsIntoCategories :: Map XFTPServer XFTPServerSummary -> ([XFTPServerSummary], [XFTPServerSummary])
+    xftpSummsIntoCategories = foldr partitionSummary ([], [])
+      where
+        partitionSummary srvSumm (curr, prev)
+          | isCurrentlyUsed srvSumm = (srvSumm : curr, prev)
+          | otherwise = (curr, srvSumm : prev)
+        isCurrentlyUsed XFTPServerSummary {sessions, rcvInProgress, sndInProgress, delInProgress} =
+          isJust sessions || rcvInProgress || sndInProgress || delInProgress
+    accSMPSrvsSummaries :: (Map SMPServer SMPServerSummary, Map SMPServer SMPServerSummary)
+    accSMPSrvsSummaries = M.foldrWithKey' (addServerData addStats) summs2 smpServersStats
+      where
+        summs1 = M.foldrWithKey' (addServerData addSessions) (M.empty, M.empty) smpServersSessions
+        summs2 = M.foldrWithKey' (addServerData addSubs) summs1 smpServersSubs
+        addServerData ::
+          (a -> SMPServerSummary -> SMPServerSummary) ->
+          (UserId, SMPServer) ->
+          a ->
+          (Map SMPServer SMPServerSummary, Map SMPServer SMPServerSummary) ->
+          (Map SMPServer SMPServerSummary, Map SMPServer SMPServerSummary)
+        addServerData addData (userId, srv) d (userSumms, allUsersSumms) = (userSumms', allUsersSumms')
+          where
+            userSumms'
+              | userId == aUserId currentUser = alterSumms newUserSummary userSumms
+              | otherwise = userSumms
+            allUsersSumms'
+              | countUserInAll userId = alterSumms newSummary allUsersSumms
+              | otherwise = allUsersSumms
+            alterSumms n = M.alter (Just . addData d . fromMaybe n) srv
+            newUserSummary = (newSummary :: SMPServerSummary) {known = Just $ srv `elem` userSMPSrvs}
+            newSummary =
+              SMPServerSummary
+                { smpServer = srv,
+                  known = Nothing,
+                  sessions = Nothing,
+                  subs = Nothing,
+                  stats = Nothing
+                }
+        addSessions :: ServerSessions -> SMPServerSummary -> SMPServerSummary
+        addSessions s summ@SMPServerSummary {sessions} = summ {sessions = Just $ maybe s (s `addServerSessions`) sessions}
+        addSubs :: SMPServerSubs -> SMPServerSummary -> SMPServerSummary
+        addSubs s summ@SMPServerSummary {subs} = summ {subs = Just $ maybe s (s `addSMPSubs`) subs}
+        addStats :: AgentSMPServerStatsData -> SMPServerSummary -> SMPServerSummary
+        addStats s summ@SMPServerSummary {stats} = summ {stats = Just $ maybe s (s `addSMPStats`) stats}
+    accXFTPSrvsSummaries :: (Map XFTPServer XFTPServerSummary, Map XFTPServer XFTPServerSummary)
+    accXFTPSrvsSummaries = M.foldrWithKey' (addServerData addStats) summs1 xftpServersStats
+      where
+        summs1 = M.foldrWithKey' (addServerData addSessions) (M.empty, M.empty) xftpServersSessions
+        addServerData ::
+          (a -> XFTPServerSummary -> XFTPServerSummary) ->
+          (UserId, XFTPServer) ->
+          a ->
+          (Map XFTPServer XFTPServerSummary, Map XFTPServer XFTPServerSummary) ->
+          (Map XFTPServer XFTPServerSummary, Map XFTPServer XFTPServerSummary)
+        addServerData addData (userId, srv) d (userSumms, allUsersSumms) = (userSumms', allUsersSumms')
+          where
+            userSumms'
+              | userId == aUserId currentUser = alterSumms newUserSummary userSumms
+              | otherwise = userSumms
+            allUsersSumms'
+              | countUserInAll userId = alterSumms newSummary allUsersSumms
+              | otherwise = allUsersSumms
+            alterSumms n = M.alter (Just . addData d . fromMaybe n) srv
+            newUserSummary = (newSummary :: XFTPServerSummary) {known = Just $ srv `elem` userXFTPSrvs}
+            newSummary =
+              XFTPServerSummary
+                { xftpServer = srv,
+                  known = Nothing,
+                  sessions = Nothing,
+                  stats = Nothing,
+                  rcvInProgress = srv `elem` xftpRcvInProgress,
+                  sndInProgress = srv `elem` xftpSndInProgress,
+                  delInProgress = srv `elem` xftpDelInProgress
+                }
+        addSessions :: ServerSessions -> XFTPServerSummary -> XFTPServerSummary
+        addSessions s summ@XFTPServerSummary {sessions} = summ {sessions = Just $ maybe s (s `addServerSessions`) sessions}
+        addStats :: AgentXFTPServerStatsData -> XFTPServerSummary -> XFTPServerSummary
+        addStats s summ@XFTPServerSummary {stats} = summ {stats = Just $ maybe s (s `addXFTPStats`) stats}
+    addServerSessions :: ServerSessions -> ServerSessions -> ServerSessions
+    addServerSessions ss1 ss2 =
+      ServerSessions
+        { ssConnected = ssConnected ss1 + ssConnected ss2,
+          ssErrors = ssErrors ss1 + ssErrors ss2,
+          ssConnecting = ssConnecting ss1 + ssConnecting ss2
+        }
+    addSMPSubs :: SMPServerSubs -> SMPServerSubs -> SMPServerSubs
+    addSMPSubs ss1 ss2 =
+      SMPServerSubs
+        { ssActive = ssActive ss1 + ssActive ss2,
+          ssPending = ssPending ss1 + ssPending ss2
+        }
+    addSMPStats :: AgentSMPServerStatsData -> AgentSMPServerStatsData -> AgentSMPServerStatsData
+    addSMPStats sd1 sd2 =
+      AgentSMPServerStatsData
+        { _sentDirect = _sentDirect sd1 + _sentDirect sd2,
+          _sentViaProxy = _sentViaProxy sd1 + _sentViaProxy sd2,
+          _sentProxied = _sentProxied sd1 + _sentProxied sd2,
+          _sentDirectAttempts = _sentDirectAttempts sd1 + _sentDirectAttempts sd2,
+          _sentViaProxyAttempts = _sentViaProxyAttempts sd1 + _sentViaProxyAttempts sd2,
+          _sentProxiedAttempts = _sentProxiedAttempts sd1 + _sentProxiedAttempts sd2,
+          _sentAuthErrs = _sentAuthErrs sd1 + _sentAuthErrs sd2,
+          _sentQuotaErrs = _sentQuotaErrs sd1 + _sentQuotaErrs sd2,
+          _sentExpiredErrs = _sentExpiredErrs sd1 + _sentExpiredErrs sd2,
+          _sentOtherErrs = _sentOtherErrs sd1 + _sentOtherErrs sd2,
+          _recvMsgs = _recvMsgs sd1 + _recvMsgs sd2,
+          _recvDuplicates = _recvDuplicates sd1 + _recvDuplicates sd2,
+          _recvCryptoErrs = _recvCryptoErrs sd1 + _recvCryptoErrs sd2,
+          _recvErrs = _recvErrs sd1 + _recvErrs sd2,
+          _connCreated = _connCreated sd1 + _connCreated sd2,
+          _connSecured = _connSecured sd1 + _connSecured sd2,
+          _connCompleted = _connCompleted sd1 + _connCompleted sd2,
+          _connDeleted = _connDeleted sd1 + _connDeleted sd2,
+          _connSubscribed = _connSubscribed sd1 + _connSubscribed sd2,
+          _connSubAttempts = _connSubAttempts sd1 + _connSubAttempts sd2,
+          _connSubErrs = _connSubErrs sd1 + _connSubErrs sd2
+        }
+    addXFTPStats :: AgentXFTPServerStatsData -> AgentXFTPServerStatsData -> AgentXFTPServerStatsData
+    addXFTPStats sd1 sd2 =
+      AgentXFTPServerStatsData
+        { _uploads = _uploads sd1 + _uploads sd2,
+          _uploadAttempts = _uploadAttempts sd1 + _uploadAttempts sd2,
+          _uploadErrs = _uploadErrs sd1 + _uploadErrs sd2,
+          _downloads = _downloads sd1 + _downloads sd2,
+          _downloadAttempts = _downloadAttempts sd1 + _downloadAttempts sd2,
+          _downloadAuthErrs = _downloadAuthErrs sd1 + _downloadAuthErrs sd2,
+          _downloadErrs = _downloadErrs sd1 + _downloadErrs sd2,
+          _deletions = _deletions sd1 + _deletions sd2,
+          _deleteAttempts = _deleteAttempts sd1 + _deleteAttempts sd2,
+          _deleteErrs = _deleteErrs sd1 + _deleteErrs sd2
+        }
+
+$(J.deriveJSON defaultJSON ''SMPServerSummary)
+
+$(J.deriveJSON defaultJSON ''XFTPServerSummary)
+
+$(J.deriveJSON defaultJSON ''ServersSummary)
+
+$(J.deriveJSON defaultJSON ''PresentedServersSummary)
@@ -523,9 +523,10 @@ getProtocolServers db User {userId} =
      (userId, decodeLatin1 $ strEncode protocol)
  where
    protocol = protocolTypeI @p
-    toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> ServerCfg p
-    toServerCfg (host, port, keyHash, auth_, preset, tested, enabled) =
+    toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Int) -> ServerCfg p
+    toServerCfg (host, port, keyHash, auth_, preset, tested, enabledInt) =
      let server = ProtoServerWithAuth (ProtocolServer protocol host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
+          enabled = toServerEnabled enabledInt
       in ServerCfg {server, preset, tested, enabled}

 overwriteProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> [ServerCfg p] -> ExceptT StoreError IO ()
@@ -542,7 +543,7 @@ overwriteProtocolServers db User {userId} servers =
            (protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
          VALUES (?,?,?,?,?,?,?,?,?,?,?)
        |]
-        ((protocol, host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_) :. (preset, tested, enabled, userId, currentTs, currentTs))
+        ((protocol, host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_) :. (preset, tested, fromServerEnabled enabled, userId, currentTs, currentTs))
    pure $ Right ()
  where
    protocol = decodeLatin1 $ strEncode $ protocolTypeI @p
@@ -1632,10 +1632,42 @@ data ServerCfg p = ServerCfg
  { server :: ProtoServerWithAuth p,
    preset :: Bool,
    tested :: Maybe Bool,
-    enabled :: Bool
+    enabled :: ServerEnabled
  }
  deriving (Show)

+data ServerEnabled
+  = SEDisabled
+  | SEEnabled
+  | -- server is marked as known, but it's not in the list of configured servers;
+    -- e.g., it may be added via an unknown server dialogue and user didn't manually configure it,
+    -- meaning server wasn't tested (or at least such option wasn't presented in UI)
+    -- and it may be inoperable for user due to server password
+    SEKnown
+  deriving (Eq, Show)
+
+pattern DBSEDisabled :: Int
+pattern DBSEDisabled = 0
+
+pattern DBSEEnabled :: Int
+pattern DBSEEnabled = 1
+
+pattern DBSEKnown :: Int
+pattern DBSEKnown = 2
+
+toServerEnabled :: Int -> ServerEnabled
+toServerEnabled = \case
+  DBSEDisabled -> SEDisabled
+  DBSEEnabled -> SEEnabled
+  DBSEKnown -> SEKnown
+  _ -> SEDisabled
+
+fromServerEnabled :: ServerEnabled -> Int
+fromServerEnabled = \case
+  SEDisabled -> DBSEDisabled
+  SEEnabled -> DBSEEnabled
+  SEKnown -> DBSEKnown
+
 data ChatVersion

 instance VersionScope ChatVersion
@@ -1764,6 +1796,8 @@ $(JQ.deriveJSON defaultJSON ''ContactRef)

 $(JQ.deriveJSON defaultJSON ''NoteFolder)

+$(JQ.deriveJSON (enumJSON $ dropPrefix "SE") ''ServerEnabled)
+
 instance ProtocolTypeI p => ToJSON (ServerCfg p) where
  toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
  toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)
@@ -36,7 +36,7 @@ import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
-import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
+import Simplex.Messaging.Util (decodeJSON, encodeJSON, safeDecodeUtf8, (<$?>))

 data ChatFeature
  = CFTimedMessages
@@ -18,6 +18,7 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Chat.Types.Util
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_)
+import Simplex.Messaging.Util (decodeJSON, encodeJSON)

 data UITheme = UITheme
  { themeId :: Text,
@@ -2,26 +2,15 @@

 module Simplex.Chat.Types.Util where

-import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
 import Data.ByteString (ByteString)
-import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
 import Data.Typeable
 import Database.SQLite.Simple (ResultError (..), SQLData (..))
 import Database.SQLite.Simple.FromField (FieldParser, returnError)
 import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Util (safeDecodeUtf8)
-
-encodeJSON :: ToJSON a => a -> Text
-encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
-
-decodeJSON :: FromJSON a => Text -> Maybe a
-decodeJSON = J.decode . LB.fromStrict . encodeUtf8

 textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a
 textParseJSON name = J.withText name $ maybe (fail $ "bad " <> name) pure . textDecode
@@ -54,7 +54,6 @@ import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
 import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Agent.Protocol (AgentErrorType (RCP))
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
 import Simplex.Messaging.Client (SMPProxyFallback, SMPProxyMode (..))
 import qualified Simplex.Messaging.Crypto as C
@@ -366,6 +365,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
      "chat entity locks: " <> viewJSON chatEntityLocks,
      "agent locks: " <> viewJSON agentLocks
    ]
+  CRAgentServersSummary u serversSummary -> ttyUser u ["agent servers summary: " <> viewJSON serversSummary]
  CRAgentStats stats -> map (plain . intercalate ",") stats
  CRAgentSubs {activeSubs, pendingSubs, removedSubs} ->
    [plain $ "Subscriptions: active = " <> show (sum activeSubs) <> ", pending = " <> show (sum pendingSubs) <> ", removed = " <> show (sum $ M.map length removedSubs)]