simplexmq/src/Simplex/Messaging/Server/Stats/Client.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Simplex.Messaging.Server.Stats.Client where

import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.Set (Set)
import Data.Time.Clock (UTCTime (..))
import Simplex.Messaging.Protocol (RecipientId)
import Simplex.Messaging.Transport (PeerId)
import UnliftIO.STM

-- | Ephemeral client ID across reconnects
type ClientStatsId = Int

data ClientStats = ClientStats
  { peerAddresses :: TVar IntSet, -- cumulative set of used PeerIds
    socketCount :: TVar Int,
    createdAt :: TVar UTCTime,
    updatedAt :: TVar UTCTime,
    qCreated :: TVar (Set RecipientId), -- can be IntSet with QueueRecIDs, for dumping into suspicous
    qSentSigned :: TVar (Set RecipientId), -- can be IntSet with QueueRecIDs
    msgSentSigned :: TVar Int,
    msgSentUnsigned :: TVar Int,
    msgDeliveredSigned :: TVar Int,
    proxyRelaysRequested :: TVar Int,
    proxyRelaysConnected :: TVar Int,
    msgSentViaProxy :: TVar Int
  }

-- may be combined with session duration to produce average rates (q/s, msg/s)
data ClientStatsData = ClientStatsData
  { _peerAddresses :: IntSet,
    _socketCount :: Int,
    _createdAt :: UTCTime,
    _updatedAt :: UTCTime,
    _qCreated :: Set RecipientId,
    _qSentSigned :: Set RecipientId,
    _msgSentSigned :: Int,
    _msgSentUnsigned :: Int,
    _msgDeliveredSigned :: Int,
    _proxyRelaysRequested :: Int,
    _proxyRelaysConnected :: Int,
    _msgSentViaProxy :: Int
  }

newClientStats :: Monad m => (forall a. a -> m (TVar a)) -> PeerId -> UTCTime -> m ClientStats
newClientStats newF peerId ts = do
  peerAddresses <- newF $ IS.singleton peerId
  socketCount <- newF 1
  createdAt <- newF ts
  updatedAt <- newF ts
  qCreated <- newF mempty
  qSentSigned <- newF mempty
  msgSentSigned <- newF 0
  msgSentUnsigned <- newF 0
  msgDeliveredSigned <- newF 0
  proxyRelaysRequested <- newF 0
  proxyRelaysConnected <- newF 0
  msgSentViaProxy <- newF 0
  pure
    ClientStats
      { peerAddresses,
        socketCount,
        createdAt,
        updatedAt,
        qCreated,
        qSentSigned,
        msgSentSigned,
        msgSentUnsigned,
        msgDeliveredSigned,
        proxyRelaysRequested,
        proxyRelaysConnected,
        msgSentViaProxy
      }
{-# INLINE newClientStats #-}

readClientStatsData :: Monad m => (forall a. TVar a -> m a) -> ClientStats -> m ClientStatsData
readClientStatsData readF cs = do
  _peerAddresses <- readF $ peerAddresses cs
  _socketCount <- readF $ socketCount cs
  _createdAt <- readF $ createdAt cs
  _updatedAt <- readF $ updatedAt cs
  _qCreated <- readF $ qCreated cs
  _qSentSigned <- readF $ qSentSigned cs
  _msgSentSigned <- readF $ msgSentSigned cs
  _msgSentUnsigned <- readF $ msgSentUnsigned cs
  _msgDeliveredSigned <- readF $ msgDeliveredSigned cs
  _proxyRelaysRequested <- readF $ proxyRelaysRequested cs
  _proxyRelaysConnected <- readF $ proxyRelaysConnected cs
  _msgSentViaProxy <- readF $ msgSentViaProxy cs
  pure
    ClientStatsData
      { _peerAddresses,
        _socketCount,
        _createdAt,
        _updatedAt,
        _qCreated,
        _qSentSigned,
        _msgSentSigned,
        _msgSentUnsigned,
        _msgDeliveredSigned,
        _proxyRelaysRequested,
        _proxyRelaysConnected,
        _msgSentViaProxy
      }
{-# INLINE readClientStatsData #-}

writeClientStatsData :: ClientStats -> ClientStatsData -> STM ()
writeClientStatsData cs csd = do
  writeTVar (peerAddresses cs) (_peerAddresses csd)
  writeTVar (socketCount cs) (_socketCount csd)
  writeTVar (createdAt cs) (_createdAt csd)
  writeTVar (updatedAt cs) (_updatedAt csd)
  writeTVar (qCreated cs) (_qCreated csd)
  writeTVar (qSentSigned cs) (_qSentSigned csd)
  writeTVar (msgSentSigned cs) (_msgSentSigned csd)
  writeTVar (msgSentUnsigned cs) (_msgSentUnsigned csd)
  writeTVar (msgDeliveredSigned cs) (_msgDeliveredSigned csd)
  writeTVar (proxyRelaysRequested cs) (_proxyRelaysRequested csd)
  writeTVar (proxyRelaysConnected cs) (_proxyRelaysConnected csd)
  writeTVar (msgSentViaProxy cs) (_msgSentViaProxy csd)

mergeClientStatsData :: ClientStatsData -> ClientStatsData -> ClientStatsData
mergeClientStatsData a b =
  ClientStatsData
    { _peerAddresses = _peerAddresses a <> _peerAddresses b,
      _socketCount = _socketCount a + _socketCount b,
      _createdAt = min (_createdAt a) (_createdAt b),
      _updatedAt = max (_updatedAt a) (_updatedAt b),
      _qCreated = _qCreated a <> _qCreated b,
      _qSentSigned = _qSentSigned a <> _qSentSigned b,
      _msgSentSigned = _msgSentSigned a + _msgSentSigned b,
      _msgSentUnsigned = _msgSentUnsigned a + _msgSentUnsigned b,
      _msgDeliveredSigned = _msgDeliveredSigned a + _msgDeliveredSigned b,
      _proxyRelaysRequested = _proxyRelaysRequested a + _proxyRelaysRequested b,
      _proxyRelaysConnected = _proxyRelaysConnected a + _proxyRelaysConnected b,
      _msgSentViaProxy = _msgSentViaProxy a + _msgSentViaProxy b
    }

-- | A column-based collection of ClientStats-related data.
data ClientStatsC a = ClientStatsC
  { peerAddressesC :: a,
    socketCountC :: a,
    qCreatedC :: a,
    qSentSignedC :: a,
    msgSentSignedC :: a,
    msgSentUnsignedC :: a,
    msgDeliveredSignedC :: a,
    proxyRelaysRequestedC :: a,
    proxyRelaysConnectedC :: a,
    msgSentViaProxyC :: a
  }
  deriving (Show, Functor)

clientStatsC :: a -> ClientStatsC a
clientStatsC x = ClientStatsC
  { peerAddressesC = x,
    socketCountC = x,
    qCreatedC = x,
    qSentSignedC = x,
    msgSentSignedC = x,
    msgSentUnsignedC = x,
    msgDeliveredSignedC = x,
    proxyRelaysRequestedC = x,
    proxyRelaysConnectedC = x,
    msgSentViaProxyC = x
  }
{-# INLINE clientStatsC #-}