diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs index 82170e90f..b462eaffa 100644 --- a/src/Simplex/Messaging/Server/Stats.hs +++ b/src/Simplex/Messaging/Server/Stats.hs @@ -47,6 +47,7 @@ data ServerStatsData = ServerStatsData _qCount :: Int, _msgCount :: Int } + deriving (Show) newServerStats :: UTCTime -> STM ServerStats newServerStats ts = do @@ -88,7 +89,7 @@ setServerStats s d = do writeTVar (qDeleted s) $! _qDeleted d writeTVar (msgSent s) $! _msgSent d writeTVar (msgRecv s) $! _msgRecv d - setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d) + setPeriodStats (activeQueues s) (_activeQueues d) writeTVar (msgSentNtf s) $! _msgSentNtf d writeTVar (msgRecvNtf s) $! _msgRecvNtf d setPeriodStats (activeQueuesNtf s) (_activeQueuesNtf d) @@ -152,6 +153,7 @@ data PeriodStatsData a = PeriodStatsData _week :: Set a, _month :: Set a } + deriving (Show) newPeriodStatsData :: PeriodStatsData a newPeriodStatsData = PeriodStatsData {_day = S.empty, _week = S.empty, _month = S.empty} diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 66315336a..5a83e5f1e 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -11,6 +11,7 @@ module ServerTests where +import AgentTests.NotificationTests (removeFileIfExists) import Control.Concurrent (ThreadId, killThread, threadDelay) import Control.Concurrent.STM import Control.Exception (SomeException, try) @@ -20,6 +21,7 @@ import Data.Bifunctor (first) import Data.ByteString.Base64 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B +import qualified Data.Set as S import SMPClient import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding @@ -28,6 +30,7 @@ import Simplex.Messaging.Parsers (parseAll) import Simplex.Messaging.Protocol import Simplex.Messaging.Server.Env.STM (ServerConfig (..)) import Simplex.Messaging.Server.Expiration +import Simplex.Messaging.Server.Stats (PeriodStatsData (..), ServerStatsData (..)) import Simplex.Messaging.Transport import System.Directory (removeFile) import System.TimeIt (timeItT) @@ -605,6 +608,10 @@ logSize f = testRestoreMessages :: ATransport -> Spec testRestoreMessages at@(ATransport t) = it "should store messages on exit and restore on start" $ do + removeFileIfExists testStoreLogFile + removeFileIfExists testStoreMsgsFile + removeFileIfExists testServerStatsBackupFile + (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519 recipientId <- newTVarIO "" recipientKey <- newTVarIO Nothing @@ -632,11 +639,15 @@ testRestoreMessages at@(ATransport t) = Resp "6" _ (ERR QUOTA) <- signSendRecv h sKey ("6", sId, _SEND "hello 6") pure () + rId <- readTVarIO recipientId + logSize testStoreLogFile `shouldReturn` 2 logSize testStoreMsgsFile `shouldReturn` 5 + logSize testServerStatsBackupFile `shouldReturn` 16 + Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile + checkStats stats1 [rId] 5 1 withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do - rId <- readTVarIO recipientId Just rKey <- readTVarIO recipientKey Just dh <- readTVarIO dhShared let dec = decryptMsgV3 dh @@ -650,9 +661,11 @@ testRestoreMessages at@(ATransport t) = logSize testStoreLogFile `shouldReturn` 1 -- the last message is not removed because it was not ACK'd logSize testStoreMsgsFile `shouldReturn` 3 + logSize testServerStatsBackupFile `shouldReturn` 16 + Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile + checkStats stats2 [rId] 5 3 withSmpServerStoreMsgLogOn at testPort . runTest t $ \h -> do - rId <- readTVarIO recipientId Just rKey <- readTVarIO recipientKey Just dh <- readTVarIO dhShared let dec = decryptMsgV3 dh @@ -667,9 +680,13 @@ testRestoreMessages at@(ATransport t) = logSize testStoreLogFile `shouldReturn` 1 logSize testStoreMsgsFile `shouldReturn` 0 + logSize testServerStatsBackupFile `shouldReturn` 16 + Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile + checkStats stats3 [rId] 5 5 removeFile testStoreLogFile removeFile testStoreMsgsFile + removeFile testServerStatsBackupFile where runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation runTest _ test' server = do @@ -679,6 +696,20 @@ testRestoreMessages at@(ATransport t) = runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation runClient _ test' = testSMPClient test' `shouldReturn` () +checkStats :: ServerStatsData -> [RecipientId] -> Int -> Int -> Expectation +checkStats s qs sent received = do + _qCreated s `shouldBe` length qs + _qSecured s `shouldBe` length qs + _qDeleted s `shouldBe` 0 + _msgSent s `shouldBe` sent + _msgRecv s `shouldBe` received + _msgSentNtf s `shouldBe` 0 + _msgRecvNtf s `shouldBe` 0 + let PeriodStatsData {_day, _week, _month} = _activeQueues s + S.toList _day `shouldBe` qs + S.toList _week `shouldBe` qs + S.toList _month `shouldBe` qs + testRestoreMessagesV2 :: ATransport -> Spec testRestoreMessagesV2 at@(ATransport t) = it "should store messages on exit and restore on start" $ do