diff --git a/apps/ios/Shared/Views/ChatList/ServersSummaryView.swift b/apps/ios/Shared/Views/ChatList/ServersSummaryView.swift index 30e32ba9d0..3639dcd5e4 100644 --- a/apps/ios/Shared/Views/ChatList/ServersSummaryView.swift +++ b/apps/ios/Shared/Views/ChatList/ServersSummaryView.swift @@ -589,7 +589,7 @@ struct DetailedSMPStatsView: View { infoRow(Text(verbatim: "NO_MSG errors"), numOrDash(stats._ackNoMsgErrs)).padding(.leading, 24) infoRow("other errors", numOrDash(stats._ackOtherErrs)).padding(.leading, 24) } - Section { + Section("Connections") { infoRow("Created", numOrDash(stats._connCreated)) infoRow("Secured", numOrDash(stats._connCreated)) infoRow("Completed", numOrDash(stats._connCompleted)) @@ -598,8 +598,12 @@ struct DetailedSMPStatsView: View { infoRowTwoValues("Subscribed", "attempts", stats._connSubscribed, stats._connSubAttempts) infoRow("Subscriptions ignored", numOrDash(stats._connSubIgnored)) infoRow("Subscription errors", numOrDash(stats._connSubErrs)) + } + Section { + infoRowTwoValues("Enabled", "attempts", stats._ntfKey, stats._ntfKeyAttempts) + infoRowTwoValues("Disabled", "attempts", stats._ntfKeyDeleted, stats._ntfKeyDeleteAttempts) } header: { - Text("Connections") + Text("Connection notifications") } footer: { Text("Starting from \(localTimestamp(statsStartedAt)).") } diff --git a/apps/ios/SimpleX NSE/NotificationService.swift b/apps/ios/SimpleX NSE/NotificationService.swift index 3850664429..30c74fa120 100644 --- a/apps/ios/SimpleX NSE/NotificationService.swift +++ b/apps/ios/SimpleX NSE/NotificationService.swift @@ -119,7 +119,7 @@ class NotificationService: UNNotificationServiceExtension { var threadId: UUID? = NSEThreads.shared.newThread() var notificationInfo: NtfMessages? var receiveEntityId: String? - var expectedMessages: Set = [] + var expectedMessage: String? // return true if the message is taken - it prevents sending it to another NotificationService instance for processing var shouldProcessNtf = false var appSubscriber: AppSubscriber? @@ -191,7 +191,7 @@ class NotificationService: UNNotificationServiceExtension { let dbStatus = startChat() if case .ok = dbStatus, let ntfInfo = apiGetNtfMessage(nonce: nonce, encNtfInfo: encNtfInfo) { - logger.debug("NotificationService: receiveNtfMessages: apiGetNtfMessage \(String(describing: ntfInfo.ntfMessages.count))") + logger.debug("NotificationService: receiveNtfMessages: apiGetNtfMessage \(String(describing: ntfInfo.ntfMessage_ == nil ? 0 : 1))") if let connEntity = ntfInfo.connEntity_ { setBestAttemptNtf( ntfInfo.ntfsEnabled @@ -201,7 +201,7 @@ class NotificationService: UNNotificationServiceExtension { if let id = connEntity.id, ntfInfo.msgTs != nil { notificationInfo = ntfInfo receiveEntityId = id - expectedMessages = Set(ntfInfo.ntfMessages.map { $0.msgId }) + expectedMessage = ntfInfo.ntfMessage_.flatMap { $0.msgId } shouldProcessNtf = true return } @@ -224,12 +224,10 @@ class NotificationService: UNNotificationServiceExtension { self.setBestAttemptNtf(.empty) } if case let .msgInfo(info) = ntf { - let found = expectedMessages.remove(info.msgId) - if found != nil { - logger.debug("NotificationService processNtf: msgInfo, last: \(self.expectedMessages.isEmpty)") - if expectedMessages.isEmpty { - self.deliverBestAttemptNtf() - } + if info.msgId == expectedMessage { + expectedMessage = nil + logger.debug("NotificationService processNtf: msgInfo") + self.deliverBestAttemptNtf() return true } else if info.msgTs > msgTs { logger.debug("NotificationService processNtf: unexpected msgInfo, let other instance to process it, stopping this one") @@ -677,9 +675,9 @@ func apiGetNtfMessage(nonce: String, encNtfInfo: String) -> NtfMessages? { return nil } let r = sendSimpleXCmd(.apiGetNtfMessage(nonce: nonce, encNtfInfo: encNtfInfo)) - if case let .ntfMessages(user, connEntity_, msgTs, ntfMessages) = r, let user = user { - logger.debug("apiGetNtfMessage response ntfMessages: \(ntfMessages.count)") - return NtfMessages(user: user, connEntity_: connEntity_, msgTs: msgTs, ntfMessages: ntfMessages) + if case let .ntfMessages(user, connEntity_, msgTs, ntfMessage_) = r, let user = user { + logger.debug("apiGetNtfMessage response ntfMessages: \(ntfMessage_ == nil ? 0 : 1)") + return NtfMessages(user: user, connEntity_: connEntity_, msgTs: msgTs, ntfMessage_: ntfMessage_) } else if case let .chatCmdError(_, error) = r { logger.debug("apiGetNtfMessage error response: \(String.init(describing: error))") } else { @@ -726,7 +724,7 @@ struct NtfMessages { var user: User var connEntity_: ConnectionEntity? var msgTs: Date? - var ntfMessages: [NtfMsgInfo] + var ntfMessage_: NtfMsgInfo? var ntfsEnabled: Bool { user.showNotifications && (connEntity_?.ntfsEnabled ?? false) diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index 5163b02c39..443b2d0502 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -662,7 +662,7 @@ public enum ChatResponse: Decodable, Error { case callInvitations(callInvitations: [RcvCallInvitation]) case ntfTokenStatus(status: NtfTknStatus) case ntfToken(token: DeviceToken, status: NtfTknStatus, ntfMode: NotificationsMode, ntfServer: String) - case ntfMessages(user_: User?, connEntity_: ConnectionEntity?, msgTs: Date?, ntfMessages: [NtfMsgInfo]) + case ntfMessages(user_: User?, connEntity_: ConnectionEntity?, msgTs: Date?, ntfMessage_: NtfMsgInfo?) case ntfMessage(user: UserRef, connEntity: ConnectionEntity, ntfMessage: NtfMsgInfo) case contactConnectionDeleted(user: UserRef, connection: PendingContactConnection) case contactDisabled(user: UserRef, contact: Contact) @@ -2377,6 +2377,10 @@ public struct AgentSMPServerStatsData: Codable { public var _connSubAttempts: Int public var _connSubIgnored: Int public var _connSubErrs: Int + public var _ntfKey: Int + public var _ntfKeyAttempts: Int + public var _ntfKeyDeleted: Int + public var _ntfKeyDeleteAttempts: Int } public struct XFTPServersSummary: Codable { @@ -2416,3 +2420,12 @@ public struct AgentXFTPServerStatsData: Codable { public var _deleteAttempts: Int public var _deleteErrs: Int } + +public struct AgentNtfServerStatsData: Codable { + public var _ntfCreated: Int + public var _ntfCreateAttempts: Int + public var _ntfChecked: Int + public var _ntfCheckAttempts: Int + public var _ntfDeleted: Int + public var _ntfDelAttempts: Int +} diff --git a/cabal.project b/cabal.project index 663bff2624..99ef5ddaeb 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 0be7ebed5c343e9f55a93224121f8a6df9333522 + tag: c605156302b78a8411a1a083c52e7d5506f11f9c source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 9a22ea9fe4..89984b4b74 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."0be7ebed5c343e9f55a93224121f8a6df9333522" = "1bx6p06nwrqsc5wc8hp86k8198vn36cs5zva2rb9zhixnjcx79ap"; + "https://github.com/simplex-chat/simplexmq.git"."c605156302b78a8411a1a083c52e7d5506f11f9c" = "064idjqf5cz2l2079gphj5gpc7pb7kc1kgg0fv5jx1ni5c4a3yzb"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 2983afa29a..cee3a78414 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1311,14 +1311,14 @@ processChatCommand' vr = \case APIVerifyToken token nonce code -> withUser $ \_ -> withAgent (\a -> verifyNtfToken a token nonce code) >> ok_ APIDeleteToken token -> withUser $ \_ -> withAgent (`deleteNtfToken` token) >> ok_ APIGetNtfMessage nonce encNtfInfo -> withUser $ \_ -> do - (NotificationInfo {ntfConnId, ntfMsgMeta}, msgs) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo + (NotificationInfo {ntfConnId, ntfMsgMeta}, msg) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo let msgTs' = systemToUTCTime . (\SMP.NMsgMeta {msgTs} -> msgTs) <$> ntfMsgMeta agentConnId = AgentConnId ntfConnId user_ <- withStore' (`getUserByAConnId` agentConnId) connEntity_ <- pure user_ $>>= \user -> withStore (\db -> Just <$> getConnectionEntity db vr user agentConnId) `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) - pure CRNtfMessages {user_, connEntity_, msgTs = msgTs', ntfMessages = map ntfMsgInfo msgs} + pure CRNtfMessages {user_, connEntity_, msgTs = msgTs', ntfMessage_ = ntfMsgInfo <$> msg} APIGetUserProtoServers userId (AProtocolType p) -> withUserId userId $ \user -> withServerProtocol p $ do cfg@ChatConfig {defaultServers} <- asks config servers <- withStore' (`getProtocolServers` user) @@ -2267,7 +2267,7 @@ processChatCommand' vr = \case cfg <- asks config (users, smpServers, xftpServers) <- withStore' $ \db -> (,,) <$> getUsers db <*> getServers db cfg user SPSMP <*> getServers db cfg user SPXFTP - let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers + let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers _defaultNtfServers pure $ CRAgentServersSummary user presentedServersSummary where getServers :: (ProtocolTypeI p, UserProtocol p) => DB.Connection -> ChatConfig -> User -> SProtocolType p -> IO (NonEmpty (ProtocolServer p)) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index fedfc463a3..922d3bef39 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -735,7 +735,7 @@ data ChatResponse | CRUserContactLinkSubError {chatError :: ChatError} -- TODO delete | CRNtfTokenStatus {status :: NtfTknStatus} | CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode, ntfServer :: NtfServer} - | CRNtfMessages {user_ :: Maybe User, connEntity_ :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]} + | CRNtfMessages {user_ :: Maybe User, connEntity_ :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessage_ :: Maybe NtfMsgInfo} | CRNtfMessage {user :: User, connEntity :: ConnectionEntity, ntfMessage :: NtfMsgInfo} | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection} | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]} diff --git a/src/Simplex/Chat/Stats.hs b/src/Simplex/Chat/Stats.hs index e1d0372080..6dd5c79ab1 100644 --- a/src/Simplex/Chat/Stats.hs +++ b/src/Simplex/Chat/Stats.hs @@ -6,6 +6,7 @@ module Simplex.Chat.Stats where import qualified Data.Aeson.TH as J +import Data.List (partition) import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M @@ -22,8 +23,10 @@ data PresentedServersSummary = PresentedServersSummary { statsStartedAt :: UTCTime, allUsersSMP :: SMPServersSummary, allUsersXFTP :: XFTPServersSummary, + allUsersNtf :: NtfServersSummary, currentUserSMP :: SMPServersSummary, - currentUserXFTP :: XFTPServersSummary + currentUserXFTP :: XFTPServersSummary, + currentUserNtf :: NtfServersSummary } deriving (Show) @@ -102,52 +105,86 @@ data XFTPServerSummary = XFTPServerSummary } deriving (Show) +data NtfServersSummary = NtfServersSummary + { ntfTotals :: NtfTotals, + currentlyUsedNtfServers :: [NtfServerSummary], + previouslyUsedNtfServers :: [NtfServerSummary] + } + deriving (Show) + +data NtfTotals = NtfTotals + { sessions :: ServerSessions, + stats :: AgentNtfServerStatsData + } + deriving (Show) + +data NtfServerSummary = NtfServerSummary + { ntfServer :: NtfServer, + known :: Maybe Bool, + sessions :: Maybe ServerSessions, + stats :: Maybe AgentNtfServerStatsData + } + 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 -> NonEmpty SMPServer -> NonEmpty XFTPServer -> PresentedServersSummary -toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrvs = do +toPresentedServersSummary :: AgentServersSummary -> [User] -> User -> NonEmpty SMPServer -> NonEmpty XFTPServer -> [NtfServer] -> PresentedServersSummary +toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrvs userNtfSrvs = do let (userSMPSrvsSumms, allSMPSrvsSumms) = accSMPSrvsSummaries - (userSMPTotals, allSMPTotals) = (accSMPTotals userSMPSrvsSumms, accSMPTotals allSMPSrvsSumms) (userSMPCurr, userSMPPrev, userSMPProx) = smpSummsIntoCategories userSMPSrvsSumms (allSMPCurr, allSMPPrev, allSMPProx) = smpSummsIntoCategories allSMPSrvsSumms - (userXFTPSrvsSumms, allXFTPSrvsSumms) = accXFTPSrvsSummaries - (userXFTPTotals, allXFTPTotals) = (accXFTPTotals userXFTPSrvsSumms, accXFTPTotals allXFTPSrvsSumms) + let (userXFTPSrvsSumms, allXFTPSrvsSumms) = accXFTPSrvsSummaries (userXFTPCurr, userXFTPPrev) = xftpSummsIntoCategories userXFTPSrvsSumms (allXFTPCurr, allXFTPPrev) = xftpSummsIntoCategories allXFTPSrvsSumms + let (userNtfSrvsSumms, allNtfSrvsSumms) = accNtfSrvsSummaries + (userNtfCurr, userNtfPrev) = ntfSummsIntoCategories userNtfSrvsSumms + (allNtfCurr, allNtfPrev) = ntfSummsIntoCategories allNtfSrvsSumms PresentedServersSummary { statsStartedAt, allUsersSMP = SMPServersSummary - { smpTotals = allSMPTotals, + { smpTotals = accSMPTotals allSMPSrvsSumms, currentlyUsedSMPServers = allSMPCurr, previouslyUsedSMPServers = allSMPPrev, onlyProxiedSMPServers = allSMPProx }, allUsersXFTP = XFTPServersSummary - { xftpTotals = allXFTPTotals, + { xftpTotals = accXFTPTotals allXFTPSrvsSumms, currentlyUsedXFTPServers = allXFTPCurr, previouslyUsedXFTPServers = allXFTPPrev }, + allUsersNtf = + NtfServersSummary + { ntfTotals = accNtfTotals allNtfSrvsSumms, + currentlyUsedNtfServers = allNtfCurr, + previouslyUsedNtfServers = allNtfPrev + }, currentUserSMP = SMPServersSummary - { smpTotals = userSMPTotals, + { smpTotals = accSMPTotals userSMPSrvsSumms, currentlyUsedSMPServers = userSMPCurr, previouslyUsedSMPServers = userSMPPrev, onlyProxiedSMPServers = userSMPProx }, currentUserXFTP = XFTPServersSummary - { xftpTotals = userXFTPTotals, + { xftpTotals = accXFTPTotals userXFTPSrvsSumms, currentlyUsedXFTPServers = userXFTPCurr, previouslyUsedXFTPServers = userXFTPPrev + }, + currentUserNtf = + NtfServersSummary + { ntfTotals = accNtfTotals userNtfSrvsSumms, + currentlyUsedNtfServers = userNtfCurr, + previouslyUsedNtfServers = userNtfPrev } } where - AgentServersSummary {statsStartedAt, smpServersSessions, smpServersSubs, smpServersStats, xftpServersSessions, xftpServersStats, xftpRcvInProgress, xftpSndInProgress, xftpDelInProgress} = agentSummary + AgentServersSummary {statsStartedAt, smpServersSessions, smpServersSubs, smpServersStats, xftpServersSessions, xftpServersStats, xftpRcvInProgress, xftpSndInProgress, xftpDelInProgress, ntfServersSessions, ntfServersStats} = agentSummary countUserInAll auId = countUserInAllStats (AgentUserId auId) currentUser users accSMPTotals :: Map SMPServer SMPServerSummary -> SMPTotals accSMPTotals = M.foldr' addTotals initialTotals @@ -168,10 +205,19 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv { sessions = maybe accSess (accSess `addServerSessions`) sessions, stats = maybe accStats (accStats `addXFTPStatsData`) stats } - smpSummsIntoCategories :: Map SMPServer SMPServerSummary -> ([SMPServerSummary], [SMPServerSummary], [SMPServerSummary]) - smpSummsIntoCategories = M.foldr' partitionSummary ([], [], []) + accNtfTotals :: Map NtfServer NtfServerSummary -> NtfTotals + accNtfTotals = M.foldr' addTotals initialTotals where - partitionSummary srvSumm (curr, prev, prox) + initialTotals = NtfTotals {sessions = ServerSessions 0 0 0, stats = newAgentNtfServerStatsData} + addTotals NtfServerSummary {sessions, stats} NtfTotals {sessions = accSess, stats = accStats} = + NtfTotals + { sessions = maybe accSess (accSess `addServerSessions`) sessions, + stats = maybe accStats (accStats `addNtfStatsData`) stats + } + smpSummsIntoCategories :: Map SMPServer SMPServerSummary -> ([SMPServerSummary], [SMPServerSummary], [SMPServerSummary]) + smpSummsIntoCategories = M.foldr' addSummary ([], [], []) + where + addSummary srvSumm (curr, prev, prox) | isCurrentlyUsed srvSumm = (srvSumm : curr, prev, prox) | isPreviouslyUsed srvSumm = (curr, srvSumm : prev, prox) | otherwise = (curr, prev, srvSumm : prox) @@ -183,42 +229,29 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv 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 = M.foldr' partitionSummary ([], []) + xftpSummsIntoCategories = partition isCurrentlyUsed . M.elems 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 + ntfSummsIntoCategories :: Map NtfServer NtfServerSummary -> ([NtfServerSummary], [NtfServerSummary]) + ntfSummsIntoCategories = partition isCurrentlyUsed . M.elems + where + isCurrentlyUsed NtfServerSummary {sessions} = isJust sessions 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 - } + addServerData = addServerData_ newSummary newUserSummary + newUserSummary srv = (newSummary srv :: SMPServerSummary) {known = Just $ srv `elem` userSMPSrvs} + newSummary srv = + 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 @@ -229,36 +262,56 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv 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 - } + addServerData = addServerData_ newSummary newUserSummary 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 `addXFTPStatsData`) stats} + newUserSummary srv = (newSummary srv :: XFTPServerSummary) {known = Just $ srv `elem` userXFTPSrvs} + newSummary srv = + XFTPServerSummary + { xftpServer = srv, + known = Nothing, + sessions = Nothing, + stats = Nothing, + rcvInProgress = srv `elem` xftpRcvInProgress, + sndInProgress = srv `elem` xftpSndInProgress, + delInProgress = srv `elem` xftpDelInProgress + } + accNtfSrvsSummaries :: (Map NtfServer NtfServerSummary, Map NtfServer NtfServerSummary) + accNtfSrvsSummaries = M.foldrWithKey' (addServerData addStats) summs1 ntfServersStats + where + summs1 = M.foldrWithKey' (addServerData addSessions) (M.empty, M.empty) ntfServersSessions + addServerData = addServerData_ newSummary newUserSummary + addSessions :: ServerSessions -> NtfServerSummary -> NtfServerSummary + addSessions s summ@NtfServerSummary {sessions} = summ {sessions = Just $ maybe s (s `addServerSessions`) sessions} + addStats :: AgentNtfServerStatsData -> NtfServerSummary -> NtfServerSummary + addStats s summ@NtfServerSummary {stats} = summ {stats = Just $ maybe s (s `addNtfStatsData`) stats} + newUserSummary srv = (newSummary srv :: NtfServerSummary) {known = Just $ srv `elem` userNtfSrvs} + newSummary srv = + NtfServerSummary + { ntfServer = srv, + known = Nothing, + sessions = Nothing, + stats = Nothing + } + addServerData_ :: + (ProtocolServer p -> s) -> + (ProtocolServer p -> s) -> + (a -> s -> s) -> + (UserId, ProtocolServer p) -> + a -> + (Map (ProtocolServer p) s, Map (ProtocolServer p) s) -> + (Map (ProtocolServer p) s, Map (ProtocolServer p) s) + addServerData_ newSummary newUserSummary addData (userId, srv) d (userSumms, allUsersSumms) = (userSumms', allUsersSumms') + where + userSumms' + | userId == aUserId currentUser = alterSumms (newUserSummary srv) userSumms + | otherwise = userSumms + allUsersSumms' + | countUserInAll userId = alterSumms (newSummary srv) allUsersSumms + | otherwise = allUsersSumms + alterSumms n = M.alter (Just . addData d . fromMaybe n) srv addServerSessions :: ServerSessions -> ServerSessions -> ServerSessions addServerSessions ss1 ss2 = ServerSessions @@ -292,4 +345,10 @@ $(J.deriveJSON defaultJSON ''XFTPServerSummary) $(J.deriveJSON defaultJSON ''XFTPServersSummary) +$(J.deriveJSON defaultJSON ''NtfTotals) + +$(J.deriveJSON defaultJSON ''NtfServerSummary) + +$(J.deriveJSON defaultJSON ''NtfServersSummary) + $(J.deriveJSON defaultJSON ''PresentedServersSummary)