diff --git a/src/Simplex/Messaging/Server/StatsStore.hs b/src/Simplex/Messaging/Server/StatsStore.hs index 0290c5501..c3bf27f7b 100644 --- a/src/Simplex/Messaging/Server/StatsStore.hs +++ b/src/Simplex/Messaging/Server/StatsStore.hs @@ -28,6 +28,7 @@ import Simplex.Messaging.Util (ifM, tshow) import System.Directory (doesFileExist, removeFile, renameFile) import UnliftIO.Exception (tryAny) #if defined(dbServerPostgres) +import Control.Concurrent.STM (readTVarIO) import Data.Bifunctor (bimap) import Data.IORef (IORef) import Data.Int (Int16, Int64) @@ -43,7 +44,7 @@ import Database.PostgreSQL.Simple (Only (..), Query) import qualified Database.PostgreSQL.Simple as DB import Database.PostgreSQL.Simple.FromRow (FromRow (..), field) import Database.PostgreSQL.Simple.ToField (ToField (..)) -import Simplex.Messaging.Agent.Store.Postgres.Common (DBStore, withTransaction) +import Simplex.Messaging.Agent.Store.Postgres.Common (DBStore (..), withTransaction) import Simplex.Messaging.Util (toChunks, whenM) import UnliftIO.Exception (isSyncException) #endif @@ -162,7 +163,7 @@ importStatsFile st f = do pure d saveDBStats :: DBStore -> ServerStats -> IO () -saveDBStats st ss = E.mask $ \unmask -> do +saveDBStats st ss = ifM (readTVarIO $ dbClosed st) (logWarn "server stats are not saved: database store is closed") $ E.mask $ \unmask -> do taken <- fmap catMaybes $ forM [minBound .. maxBound] $ \ps -> forM (periodSetPending ss ps) $ \ref -> (ps,ref,) <$> takePendingHashes ref d <- getServerStatsData ss diff --git a/tests/CoreTests/ServerStatsTests.hs b/tests/CoreTests/ServerStatsTests.hs index 13072afaf..6efaedbee 100644 --- a/tests/CoreTests/ServerStatsTests.hs +++ b/tests/CoreTests/ServerStatsTests.hs @@ -27,6 +27,7 @@ import Control.Monad (void) import CoreTests.MsgStoreTests (testPostgresStoreConfig) import qualified Database.PostgreSQL.Simple as DB import Data.String (fromString) +import Simplex.Messaging.Agent.Store.Postgres (closeDBStore) import Simplex.Messaging.Agent.Store.Postgres.Common (DBStore, withTransaction) import Simplex.Messaging.Server.MsgStore.Postgres (PostgresMsgStore) import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..)) @@ -52,6 +53,7 @@ serverStatsTests = do it "should save added hashes and delete reset sets" testDBResetAndAdded it "should keep pending hashes when save fails" testDBSaveFailure it "should keep pending hashes when save is cancelled" testDBSaveCancelled + it "should not save when database store is closed" testDBSaveClosed it "should import stats file when database has no stats" testDBImportFile it "should ignore stats file when database has stats" testDBIgnoreFile #endif @@ -251,6 +253,16 @@ testDBSaveCancelled = withStatsDB $ \st -> do Just d <- getDBStats st _day (_activeQueues d) `shouldBe` hashes [q1] +testDBSaveClosed :: HasTestEnv => IO () +testDBSaveClosed = withStatsDB $ \st -> do + ss <- newServerStats True wednesday + let msgQueues = activeQueues ss + updatePeriodStats msgQueues q1 + closeDBStore st + timeout 5000000 (saveStats (StatsDB st statsFile) ss) `shouldReturn` Just () + Just PendingPeriods {pendingDay} <- pure $ pendingPeriods msgQueues + takePendingHashes pendingDay `shouldReturn` added [q1] + testDBImportFile :: HasTestEnv => IO () testDBImportFile = withStatsDB $ \st -> do ss <- newDistinctStats False