simplex-chat/src/Simplex/Chat/Stats.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.Chat.Stats where

import qualified Data.Aeson.TH as J
import Data.List (partition)
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,
    allUsersSMP :: SMPServersSummary,
    allUsersXFTP :: XFTPServersSummary,
    allUsersNtf :: NtfServersSummary,
    currentUserSMP :: SMPServersSummary,
    currentUserXFTP :: XFTPServersSummary,
    currentUserNtf :: NtfServersSummary
  }
  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 SMPServersSummary = SMPServersSummary
  { -- SMP totals are calculated from all accounted SMP server summaries
    smpTotals :: SMPTotals,
    -- 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]
  }
  deriving (Show)

data SMPTotals = SMPTotals
  { sessions :: ServerSessions,
    subs :: SMPServerSubs,
    stats :: AgentSMPServerStatsData
  }
  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 XFTPServersSummary = XFTPServersSummary
  { -- XFTP totals are calculated from all accounted XFTP server summaries
    xftpTotals :: XFTPTotals,
    -- 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 XFTPTotals = XFTPTotals
  { sessions :: ServerSessions,
    stats :: AgentXFTPServerStatsData
  }
  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)

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 -> [SMPServer] -> [XFTPServer] -> [NtfServer] -> PresentedServersSummary
toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrvs userNtfSrvs = do
  let (userSMPSrvsSumms, allSMPSrvsSumms) = accSMPSrvsSummaries
      (userSMPCurr, userSMPPrev, userSMPProx) = smpSummsIntoCategories userSMPSrvsSumms
      (allSMPCurr, allSMPPrev, allSMPProx) = smpSummsIntoCategories allSMPSrvsSumms
  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 = accSMPTotals allSMPSrvsSumms,
            currentlyUsedSMPServers = allSMPCurr,
            previouslyUsedSMPServers = allSMPPrev,
            onlyProxiedSMPServers = allSMPProx
          },
      allUsersXFTP =
        XFTPServersSummary
          { xftpTotals = accXFTPTotals allXFTPSrvsSumms,
            currentlyUsedXFTPServers = allXFTPCurr,
            previouslyUsedXFTPServers = allXFTPPrev
          },
      allUsersNtf =
        NtfServersSummary
          { ntfTotals = accNtfTotals allNtfSrvsSumms,
            currentlyUsedNtfServers = allNtfCurr,
            previouslyUsedNtfServers = allNtfPrev
          },
      currentUserSMP =
        SMPServersSummary
          { smpTotals = accSMPTotals userSMPSrvsSumms,
            currentlyUsedSMPServers = userSMPCurr,
            previouslyUsedSMPServers = userSMPPrev,
            onlyProxiedSMPServers = userSMPProx
          },
      currentUserXFTP =
        XFTPServersSummary
          { 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, ntfServersSessions, ntfServersStats} = agentSummary
    countUserInAll auId = countUserInAllStats (AgentUserId auId) currentUser users
    accSMPTotals :: Map SMPServer SMPServerSummary -> SMPTotals
    accSMPTotals = M.foldr' addTotals initialTotals
      where
        initialTotals = SMPTotals {sessions = ServerSessions 0 0 0, subs = SMPServerSubs 0 0, stats = newAgentSMPServerStatsData}
        addTotals SMPServerSummary {sessions, subs, stats} SMPTotals {sessions = accSess, subs = accSubs, stats = accStats} =
          SMPTotals
            { sessions = maybe accSess (accSess `addServerSessions`) sessions,
              subs = maybe accSubs (accSubs `addSMPSubs`) subs,
              stats = maybe accStats (accStats `addSMPStatsData`) stats
            }
    accXFTPTotals :: Map XFTPServer XFTPServerSummary -> XFTPTotals
    accXFTPTotals = M.foldr' addTotals initialTotals
      where
        initialTotals = XFTPTotals {sessions = ServerSessions 0 0 0, stats = newAgentXFTPServerStatsData}
        addTotals XFTPServerSummary {sessions, stats} XFTPTotals {sessions = accSess, stats = accStats} =
          XFTPTotals
            { sessions = maybe accSess (accSess `addServerSessions`) sessions,
              stats = maybe accStats (accStats `addXFTPStatsData`) stats
            }
    accNtfTotals :: Map NtfServer NtfServerSummary -> NtfTotals
    accNtfTotals = M.foldr' addTotals initialTotals
      where
        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)
        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 = partition isCurrentlyUsed . M.elems
      where
        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 = 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
        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 `addSMPStatsData`) 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 = 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
        { ssConnected = ssConnected ss1 + ssConnected ss2,
          ssErrors = ssErrors ss1 + ssErrors ss2,
          ssConnecting = ssConnecting ss1 + ssConnecting ss2
        }

countUserInAllStats :: AgentUserId -> User -> [User] -> Bool
countUserInAllStats (AgentUserId auId) currentUser users =
  auId == aUserId currentUser || auId `notElem` hiddenUserIds
  where
    hiddenUserIds = map aUserId $ filter (isJust . viewPwdHash) users

addSMPSubs :: SMPServerSubs -> SMPServerSubs -> SMPServerSubs
addSMPSubs ss1 ss2 =
  SMPServerSubs
    { ssActive = ssActive ss1 + ssActive ss2,
      ssPending = ssPending ss1 + ssPending ss2
    }

$(J.deriveJSON defaultJSON ''SMPTotals)

$(J.deriveJSON defaultJSON ''SMPServerSummary)

$(J.deriveJSON defaultJSON ''SMPServersSummary)

$(J.deriveJSON defaultJSON ''XFTPTotals)

$(J.deriveJSON defaultJSON ''XFTPServerSummary)

$(J.deriveJSON defaultJSON ''XFTPServersSummary)

$(J.deriveJSON defaultJSON ''NtfTotals)

$(J.deriveJSON defaultJSON ''NtfServerSummary)

$(J.deriveJSON defaultJSON ''NtfServersSummary)

$(J.deriveJSON defaultJSON ''PresentedServersSummary)