smp-server: remove journal message store

src/Simplex/Messaging/Agent/Client.hs

@@ -34,7 +34,6 @@ module Simplex.Messaging.Agent.Client
     withInvLock,
     withLockMap,
     withLocksMap,
-    getMapLock,
     ipAddressProtected,
     closeAgentClient,
     closeProtocolServerClients,

src/Simplex/Messaging/Agent/Lock.hs

@@ -6,7 +6,6 @@ module Simplex.Messaging.Agent.Lock
     withLock',
     withGetLock,
     withGetLocks,
-    getPutLock,
   )
 where
 

src/Simplex/Messaging/Server.hs

@@ -33,9 +33,6 @@ module Simplex.Messaging.Server
   ( runSMPServer,
     runSMPServerBlocking,
     controlPortAuth,
-    importMessages,
-    exportMessages,
-    printMessageStats,
     disconnectTransport,
     verifyCmdAuthorization,
     dummyVerifyCmd,
@@ -108,7 +105,6 @@ import Simplex.Messaging.Server.Control
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
-import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore, JournalQueue (..), getJournalQueueMessages)
 import Simplex.Messaging.Server.Names (NamesEnv, closeNamesEnv, resolveName)
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
@@ -116,6 +112,7 @@ import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.Prometheus
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
+import Simplex.Messaging.Server.QueueStore.STM (withLoadedQueues)
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog (foldLogLines)
@@ -145,7 +142,7 @@ import GHC.Conc.Sync (threadLabel)
 #endif
 
 #if defined(dbServerPostgres)
-import Simplex.Messaging.Server.MsgStore.Postgres (exportDbMessages, getDbMessageStats)
+import Simplex.Messaging.Server.MsgStore.Postgres (getDbMessageStats)
 #endif
 
 -- | Runs an SMP server using passed configuration.
@@ -710,7 +707,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
       (deliveredSubs, deliveredTimes) <- getDeliveredMetrics =<< getSystemSeconds
       smpSubs <- getSubscribersMetrics subscribers
       ntfSubs <- getSubscribersMetrics ntfSubscribers
-      loadedCounts <- loadedQueueCounts $ fromMsgStore ms
+      loadedCounts <- case ms of
+        StoreMemory st -> Just <$> loadedQueueCounts st
+#if defined(dbServerPostgres)
+        StoreDatabase _ -> pure Nothing
+#endif
       pure RealTimeMetrics {socketStats, threadsCount, clientsCount, deliveredSubs, deliveredTimes, smpSubs, ntfSubs, loadedCounts}
       where
         getSubscribersMetrics ServerSubscribers {queueSubscribers, serviceSubscribers, totalServiceSubs, subClients} = do
@@ -2273,40 +2274,27 @@ randomId = fmap EntityId . randomId'
 
 saveServerMessages :: Bool -> MsgStore s -> IO ()
 saveServerMessages drainMsgs ms = case ms of
-  StoreMemory STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-    Just f -> exportMessages False ms f drainMsgs
+  StoreMemory ms'@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
+    Just f -> exportMessages ms' f drainMsgs
     Nothing -> logNote "undelivered messages are not saved"
-  StoreJournal _ -> logNote "closed journal message storage"
 #if defined(dbServerPostgres)
   StoreDatabase _ -> logNote "closed postgres message storage"
 #endif
 
-exportMessages :: forall s. MsgStoreClass s => Bool -> MsgStore s -> FilePath -> Bool -> IO ()
-exportMessages tty st f drainMsgs = do
+exportMessages :: STMMsgStore -> FilePath -> Bool -> IO ()
+exportMessages ms f drainMsgs = do
   logNote $ "saving messages to file " <> T.pack f
-  run $ case st of
-    StoreMemory ms -> exportMessages_ ms $ getMsgs ms
-    StoreJournal ms -> exportMessages_ ms $ getJournalMsgs ms
-#if defined(dbServerPostgres)
-    StoreDatabase ms -> exportDbMessages tty ms
-#endif
+  run $ fmap (\(Sum n) -> n) . withLoadedQueues (queueStore ms) . saveQueueMsgs
   where
-    exportMessages_ ms get = fmap (\(Sum n) -> n) . unsafeWithAllMsgQueues tty ms . saveQueueMsgs get
     run :: (Handle -> IO Int) -> IO ()
     run a = liftIO $ withFile f WriteMode $ tryAny . a >=> \case
       Right n -> logNote $ "messages saved: " <> tshow n
       Left e -> do
         logError $ "error exporting messages: " <> tshow e
         exitFailure
-    getJournalMsgs ms q =
-      readTVarIO (msgQueue' q) >>= \case
-        Just _ -> getMsgs ms q
-        Nothing -> getJournalQueueMessages ms q
-    getMsgs :: MsgStoreClass s' => s' -> StoreQueue s' -> IO [Message]
-    getMsgs ms q = unsafeRunStore q "saveQueueMsgs" $ getQueueMessages_ drainMsgs q =<< getMsgQueue ms q False
-    saveQueueMsgs :: (StoreQueue s -> IO [Message]) -> Handle -> StoreQueue s -> IO (Sum Int)
-    saveQueueMsgs get h q = do
-      msgs <- get q
+    saveQueueMsgs :: Handle -> STMQueue -> IO (Sum Int)
+    saveQueueMsgs h q = do
+      msgs <- getQueueMessages drainMsgs q
       unless (null msgs) $ BLD.hPutBuilder h $ encodeMessages (recipientId q) msgs
       pure $ Sum $ length msgs
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
@@ -2318,37 +2306,16 @@ processServerMessages StartOptions {skipWarnings} = do
   asks msgStore_ >>= liftIO . processMessages old_ expire
     where
       processMessages :: Maybe Int64 -> Bool -> MsgStore s' -> IO (Maybe MessageStats)
+#if defined(dbServerPostgres)
       processMessages old_ expire = \case
+#else
+      processMessages old_ _ = \case
+#endif
         StoreMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-          Just f -> ifM (doesFileExist f) (Just <$> importMessages False ms f old_ skipWarnings) (pure Nothing)
+          Just f -> ifM (doesFileExist f) (Just <$> importMessages ms f old_ skipWarnings) (pure Nothing)
           Nothing -> pure Nothing
-        StoreJournal ms -> processJournalMessages old_ expire ms
 #if defined(dbServerPostgres)
         StoreDatabase ms -> processDbMessages old_ expire ms
-#endif
-      processJournalMessages :: forall s. Maybe Int64 -> Bool -> JournalMsgStore s -> IO (Maybe MessageStats)
-      processJournalMessages old_ expire ms
-        | expire = Just <$> case old_ of
-            Just old -> do
-              logNote "expiring journal store messages..."
-              run $ processExpireQueue old
-            Nothing -> do
-              logNote "validating journal store messages..."
-              run processValidateQueue
-        | otherwise = logWarn "skipping message expiration" $> Nothing
-        where
-          run a = unsafeWithAllMsgQueues False ms a `catchAny` \_ -> exitFailure
-          processExpireQueue :: Int64 -> JournalQueue s -> IO MessageStats
-          processExpireQueue old q = unsafeRunStore q "processExpireQueue" $ do
-            mq <- getMsgQueue ms q False
-            expiredMsgsCount <- deleteExpireMsgs_ old q mq
-            storedMsgsCount <- getQueueSize_ mq
-            pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
-          processValidateQueue :: JournalQueue s -> IO MessageStats
-          processValidateQueue q = unsafeRunStore q "processValidateQueue" $ do
-            storedMsgsCount <- getQueueSize_ =<< getMsgQueue ms q False
-            pure newMessageStats {storedMsgsCount, storedQueues = 1}
-#if defined(dbServerPostgres)
       processDbMessages old_ expire ms
         | expire = Just <$> case old_ of
             Just old -> do
@@ -2360,18 +2327,17 @@ processServerMessages StartOptions {skipWarnings} = do
         | otherwise = logWarn "skipping message expiration" $> Nothing
 #endif
 
-importMessages :: forall s. MsgStoreClass s => Bool -> s -> FilePath -> Maybe Int64 -> Bool -> IO MessageStats
-importMessages tty ms f old_ skipWarnings  = do
+importMessages :: STMMsgStore -> FilePath -> Maybe Int64 -> Bool -> IO MessageStats
+importMessages ms f old_ skipWarnings  = do
   logNote $ "restoring messages from file " <> T.pack f
   (_, (storedMsgsCount, expiredMsgsCount, overQuota)) <-
-    foldLogLines tty f restoreMsg (Nothing, (0, 0, M.empty))
+    foldLogLines False f restoreMsg (Nothing, (0, 0, M.empty))
   renameFile f $ f <> ".bak"
   mapM_ setOverQuota_ overQuota
-  logQueueStates ms
-  EntityCounts {queueCount} <- liftIO $ getEntityCounts @(StoreQueue s) $ queueStore ms
+  EntityCounts {queueCount} <- liftIO $ getEntityCounts @STMQueue $ queueStore ms
   pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = queueCount}
   where
-    restoreMsg :: (Maybe (RecipientId, StoreQueue s), (Int, Int, Map RecipientId (StoreQueue s))) -> Bool -> ByteString -> IO (Maybe (RecipientId, StoreQueue s), (Int, Int, Map RecipientId (StoreQueue s)))
+    restoreMsg :: (Maybe (RecipientId, STMQueue), (Int, Int, Map RecipientId STMQueue)) -> Bool -> ByteString -> IO (Maybe (RecipientId, STMQueue), (Int, Int, Map RecipientId STMQueue))
     restoreMsg (q_, counts@(!stored, !expired, !overQuota)) eof s = case strDecode s of
       Right (MLRv3 rId msg) -> runExceptT (addToMsgQueue rId msg) >>= either (exitErr . tshow) pure
       Left e
@@ -2379,7 +2345,6 @@ importMessages tty ms f old_ skipWarnings  = do
         | otherwise -> exitErr $ parsingErr e
       where
         exitErr e = do
-          when tty $ putStrLn ""
           logError $ "error restoring messages: " <> e
           liftIO exitFailure
         parsingErr :: String -> Text
@@ -2392,7 +2357,6 @@ importMessages tty ms f old_ skipWarnings  = do
           case qOrErr of
             Right q -> addToQueue_ q rId msg
             Left AUTH -> liftIO $ do
-              when tty $ putStrLn ""
               warnOrExit $ "queue " <> safeDecodeUtf8 (encode $ unEntityId rId) <> " does not exist"
               pure (Nothing, counts)
             Left e -> throwE e
@@ -2403,20 +2367,13 @@ importMessages tty ms f old_ skipWarnings  = do
                   writeMsg ms q False msg >>= \case
                     Just _ -> pure (stored + 1, expired, overQuota)
                     Nothing -> liftIO $ do
-                      when tty $ putStrLn ""
                       logError $ decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
                       pure counts
               | otherwise -> pure (stored, expired + 1, overQuota)
             MessageQuota {} ->
               -- queue was over quota at some point,
               -- it will be set as over quota once fully imported
-              mergeQuotaMsgs >> writeMsg ms q False msg $> (stored, expired, M.insert rId q overQuota)
-              where
-                -- if the first message in queue head is "quota", remove it.
-                mergeQuotaMsgs =
-                  withPeekMsgQueue ms q "mergeQuotaMsgs" $ maybe (pure ()) $ \case
-                    (mq, MessageQuota {}) -> tryDeleteMsg_ q mq False
-                    _ -> pure ()
+              deleteQuotaMsg q >> writeMsg ms q False msg $> (stored, expired, M.insert rId q overQuota)
         warnOrExit e
           | skipWarnings = logWarn e'
           | otherwise = do

src/Simplex/Messaging/Server/Env/STM.hs

@@ -42,7 +42,6 @@ module Simplex.Messaging.Server.Env.STM
     VerifiedTransmission,
     ResponseAndMessage,
     newEnv,
-    mkJournalStoreConfig,
     msgStore,
     fromMsgStore,
     newClient,
@@ -68,10 +67,6 @@ module Simplex.Messaging.Server.Env.STM
     defaultInactiveClientExpiration,
     defaultProxyClientConcurrency,
     defaultNameResolverConcurrency,
-    defaultMaxJournalMsgCount,
-    defaultMaxJournalStateLines,
-    defaultIdleQueueInterval,
-    journalMsgStoreDepth,
     readWriteQueueStore,
     noPostgresExitStr,
     noPostgresExit,
@@ -96,7 +91,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import Data.Maybe (isJust)
 import qualified Data.Text as T
-import Data.Time.Clock (getCurrentTime, nominalDay)
+import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..))
@@ -113,7 +108,6 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
-import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.Names (NamesConfig (..), NamesEnv, newNamesEnv, pingEndpoint)
@@ -146,8 +140,6 @@ data ServerConfig s = ServerConfig
     smpHandshakeTimeout :: Int,
     tbqSize :: Natural,
     msgQueueQuota :: Int,
-    maxJournalMsgCount :: Int,
-    maxJournalStateLines :: Int,
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     serverStoreCfg :: ServerStoreCfg s,
@@ -164,8 +156,6 @@ data ServerConfig s = ServerConfig
     messageExpiration :: Maybe ExpirationConfig,
     expireMessagesOnStart :: Bool,
     expireMessagesOnSend :: Bool,
-    -- | interval of inactivity after which journal queue is closed
-    idleQueueInterval :: Int64,
     -- | notification expiration interval (seconds)
     notificationExpiration :: ExpirationConfig,
     -- | time after which the socket with inactive client can be disconnected (without any messages or commands, incl. PING),
@@ -229,9 +219,6 @@ defaultMessageExpiration =
       checkInterval = 7200 -- seconds, 2 hours
     }
 
-defaultIdleQueueInterval :: Int64
-defaultIdleQueueInterval = 14400 -- seconds, 4 hours
-
 defNtfExpirationHours :: Int64
 defNtfExpirationHours = 24
 
@@ -255,21 +242,9 @@ defaultProxyClientConcurrency = 32
 defaultNameResolverConcurrency :: Int
 defaultNameResolverConcurrency = 1000
 
-journalMsgStoreDepth :: Int
-journalMsgStoreDepth = 5
-
-defaultMaxJournalStateLines :: Int
-defaultMaxJournalStateLines = 16
-
-defaultMaxJournalMsgCount :: Int
-defaultMaxJournalMsgCount = 256
-
 defaultMsgQueueQuota :: Int
 defaultMsgQueueQuota = 128
 
-defaultStateTailSize :: Int
-defaultStateTailSize = 512
-
 data Env s = Env
   { config :: ServerConfig s,
     serverActive :: TVar Bool,
@@ -295,7 +270,6 @@ msgStore = fromMsgStore . msgStore_
 fromMsgStore :: MsgStore s -> s
 fromMsgStore = \case
   StoreMemory s -> s
-  StoreJournal s -> s
 #if defined(dbServerPostgres)
   StoreDatabase s -> s
 #endif
@@ -303,12 +277,10 @@ fromMsgStore = \case
 
 type family SupportedStore (qs :: QSType) (ms :: MSType) :: Constraint where
   SupportedStore 'QSMemory 'MSMemory = ()
-  SupportedStore 'QSMemory 'MSJournal = ()
   SupportedStore 'QSMemory 'MSPostgres =
     (Int ~ Bool, TypeError ('TE.Text "Storing messages in Postgres DB with queues in memory is not supported"))
   SupportedStore 'QSPostgres 'MSMemory =
     (Int ~ Bool, TypeError ('TE.Text "Storing messages in memory with queues in Postgres DB is not supported"))
-  SupportedStore 'QSPostgres 'MSJournal = ()
 #if defined(dbServerPostgres)
   SupportedStore 'QSPostgres 'MSPostgres = ()
 #else
@@ -322,8 +294,6 @@ data AStoreType =
 
 data ServerStoreCfg s where
   SSCMemory :: Maybe StorePaths -> ServerStoreCfg STMMsgStore
-  SSCMemoryJournal :: {storeLogFile :: FilePath, storeMsgsPath :: FilePath} -> ServerStoreCfg (JournalMsgStore 'QSMemory)
-  SSCDatabaseJournal :: {storeCfg :: PostgresStoreCfg, storeMsgsPath' :: FilePath} -> ServerStoreCfg (JournalMsgStore 'QSPostgres)
 #if defined(dbServerPostgres)
   SSCDatabase :: PostgresStoreCfg -> ServerStoreCfg PostgresMsgStore
 #endif
@@ -331,8 +301,6 @@ data ServerStoreCfg s where
 dbStoreCfg :: ServerStoreCfg s -> Maybe PostgresStoreCfg
 dbStoreCfg = \case
   SSCMemory _ -> Nothing
-  SSCMemoryJournal {} -> Nothing
-  SSCDatabaseJournal {storeCfg} -> Just storeCfg
 #if defined(dbServerPostgres)
   SSCDatabase cfg -> Just cfg
 #endif
@@ -340,8 +308,6 @@ dbStoreCfg = \case
 storeLogFile' :: ServerStoreCfg s -> Maybe FilePath
 storeLogFile' = \case
   SSCMemory sp_ -> (\StorePaths {storeLogFile} -> storeLogFile) <$> sp_
-  SSCMemoryJournal {storeLogFile} -> Just storeLogFile
-  SSCDatabaseJournal {storeCfg = PostgresStoreCfg {dbStoreLogPath}} -> dbStoreLogPath
 #if defined(dbServerPostgres)
   SSCDatabase (PostgresStoreCfg {dbStoreLogPath}) -> dbStoreLogPath
 #endif
@@ -350,14 +316,12 @@ data StorePaths = StorePaths {storeLogFile :: FilePath, storeMsgsFile :: Maybe F
 
 type family MsgStoreType (qs :: QSType) (ms :: MSType) where
   MsgStoreType 'QSMemory 'MSMemory = STMMsgStore
-  MsgStoreType qs 'MSJournal = JournalMsgStore qs
 #if defined(dbServerPostgres)
   MsgStoreType 'QSPostgres 'MSPostgres = PostgresMsgStore
 #endif
 
 data MsgStore s where
   StoreMemory :: STMMsgStore -> MsgStore STMMsgStore
-  StoreJournal :: JournalMsgStore qs -> MsgStore (JournalMsgStore qs)
 #if defined(dbServerPostgres)
   StoreDatabase :: PostgresMsgStore -> MsgStore PostgresMsgStore
 #endif
@@ -571,39 +535,21 @@ newProhibitedSub = do
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig s -> IO (Env s)
-newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig} = do
+newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, msgQueueQuota, namesConfig} = do
   serverActive <- newTVarIO True
   server <- newServer
   msgStore_ <- case serverStoreCfg of
     SSCMemory storePaths_ -> do
       let storePath = storeMsgsFile =<< storePaths_
       ms <- newMsgStore STMStoreConfig {storePath, quota = msgQueueQuota}
-      forM_ storePaths_ $ \StorePaths {storeLogFile = f} -> loadStoreLog (mkQueue ms True) f $ queueStore ms
+      forM_ storePaths_ $ \StorePaths {storeLogFile = f} -> loadStoreLog (mkQueue ms) f $ queueStore ms
       pure $ StoreMemory ms
-    SSCMemoryJournal {storeLogFile, storeMsgsPath} -> do
-      logWarn $
-        "Journal message store is deprecated and will be removed soon.\n"
-          <> "Please migrate to in-memory storage using `journal export` command.\n"
-          <> "After that you can migrate to PostgreSQL using `database import` command."
-      let qsCfg = MQStoreCfg
-          cfg = mkJournalStoreConfig qsCfg storeMsgsPath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval
-      ms <- newMsgStore cfg
-      loadStoreLog (mkQueue ms True) storeLogFile $ stmQueueStore ms
-      pure $ StoreJournal ms
 #if defined(dbServerPostgres)
-    SSCDatabaseJournal {storeCfg, storeMsgsPath'} -> do
-      let StartOptions {compactLog, confirmMigrations} = startOptions config
-          qsCfg = PQStoreCfg (storeCfg {confirmMigrations} :: PostgresStoreCfg)
-          cfg = mkJournalStoreConfig qsCfg storeMsgsPath' msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval
-      when compactLog $ compactDbStoreLog $ dbStoreLogPath storeCfg
-      StoreJournal <$> newMsgStore cfg
     SSCDatabase storeCfg -> do
       let StartOptions {compactLog, confirmMigrations} = startOptions config
           cfg = PostgresMsgStoreCfg storeCfg {confirmMigrations} msgQueueQuota
       when compactLog $ compactDbStoreLog $ dbStoreLogPath storeCfg
       StoreDatabase <$> newMsgStore cfg
-#else
-    SSCDatabaseJournal {} -> noPostgresExit
 #endif
   ntfStore <- NtfStore <$> TM.emptyIO
   random <- C.newRandom
@@ -655,8 +601,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
       Just f -> do
         logNote $ "compacting queues in file " <> T.pack f
         st <- newMsgStore STMStoreConfig {storePath = Nothing, quota = msgQueueQuota}
-        -- we don't need to have locks in the map
-        sl <- readWriteQueueStore False (mkQueue st False) f (queueStore st)
+        sl <- readWriteQueueStore False (mkQueue st) f (queueStore st)
         setStoreLog (queueStore st) sl
         closeMsgStore st
       Nothing -> do
@@ -703,7 +648,9 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
             Nothing -> SPMMemoryOnly
             Just StorePaths {storeMsgsFile = Just _} -> SPMMessages
             _ -> SPMQueues
-          _ -> SPMMessages
+#if defined(dbServerPostgres)
+          SSCDatabase _ -> SPMMessages
+#endif
 
 noPostgresExit :: IO a
 noPostgresExit = putStrLn noPostgresExitStr >> exitFailure
@@ -713,21 +660,6 @@ noPostgresExitStr =
   "Error: server binary is compiled without support for PostgreSQL database.\n"
     <> "Please download `smp-server-postgres` or re-compile with `cabal build -fserver_postgres`."
 
-mkJournalStoreConfig :: QStoreCfg s -> FilePath -> Int -> Int -> Int -> Int64 -> JournalStoreConfig s
-mkJournalStoreConfig queueStoreCfg storePath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval =
-  JournalStoreConfig
-    { storePath,
-      quota = msgQueueQuota,
-      pathParts = journalMsgStoreDepth,
-      queueStoreCfg,
-      maxMsgCount = maxJournalMsgCount,
-      maxStateLines = maxJournalStateLines,
-      stateTailSize = defaultStateTailSize,
-      idleInterval = idleQueueInterval,
-      expireBackupsAfter = 14 * nominalDay,
-      keepMinBackups = 2
-    }
-
 newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
 newSMPProxyAgent smpAgentCfg random = do
   smpAgent <- newSMPClientAgent SSender smpAgentCfg Nothing random

src/Simplex/Messaging/Server/Main.hs

@@ -28,8 +28,6 @@ module Simplex.Messaging.Server.Main
     importMessagesToDatabase,
     exportDatabaseToStoreLog,
 #endif
-    newJournalMsgStore,
-    storeMsgsJournalDir',
     getServerSourceCode,
     simplexmqSource,
     serverPublicInfo,
@@ -61,7 +59,6 @@ import qualified Data.Text.IO as T
 import Options.Applicative
 import Simplex.Messaging.Agent.Protocol (ConnectionLink (..), ConnectionMode (..), connReqUriP')
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
-import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SMPWebPortServers (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
@@ -69,23 +66,20 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Network.URI (URI (..), URIAuth (..), parseAbsoluteURI)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
-import Simplex.Messaging.Server (AttachHTTP, exportMessages, importMessages, printMessageStats, runSMPServer)
+import Simplex.Messaging.Server (AttachHTTP, runSMPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.Main.Init
 import Simplex.Messaging.Server.Web (EmbeddedWebParams (..), WebHttpsParams (..))
-import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore (..), QStoreCfg (..), stmQueueStore)
-import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SQSType (..), SMSType (..), newMsgStore)
+import Simplex.Messaging.Server.MsgStore.Types (SQSType (..), SMSType (..))
 import Simplex.Messaging.Server.Names (NamesConfig (..), RpcAuth (..))
-import Simplex.Messaging.Server.QueueStore.Postgres.Config
-import Simplex.Messaging.Server.StoreLog.ReadWrite (readQueueStore)
 import Simplex.Messaging.Transport (supportedProxyClientSMPRelayVRange, alpnSupportedSMPHandshakes, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (TransportHost (..), defaultSocksProxy)
 import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
-import Simplex.Messaging.Util (eitherToMaybe, ifM, safeDecodeUtf8)
+import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, whenM)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
@@ -98,15 +92,16 @@ import Data.Int (Int64)
 import qualified Data.Map.Strict as M
 import Data.Semigroup (Sum (..))
 import Simplex.Messaging.Agent.Store.Postgres (checkSchemaExists)
-import Simplex.Messaging.Server.MsgStore.Journal (JournalQueue)
-import Simplex.Messaging.Server.MsgStore.Types (QSType (..))
-import Simplex.Messaging.Server.MsgStore.Journal (postgresQueueStore)
+import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Server.MsgStore.Postgres
-import Simplex.Messaging.Server.QueueStore.Postgres (batchInsertQueues, batchInsertServices, foldQueueRecs, foldServiceRecs)
+import Simplex.Messaging.Server.MsgStore.STM (STMStoreConfig (..))
+import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), newMsgStore)
+import Simplex.Messaging.Server.QueueStore.Postgres.Config
+import Simplex.Messaging.Server.QueueStore.Postgres (PostgresQueueStore, batchInsertQueues, batchInsertServices, foldQueueRecs, foldServiceRecs)
 import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..))
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog (closeStoreLog, logNewService, logCreateQueue, openWriteStoreLog)
-import Simplex.Messaging.Util (unlessM)
+import Simplex.Messaging.Util (ifM)
 import System.Directory (renameFile)
 import System.IO (IOMode (..), withFile)
 #endif
@@ -136,79 +131,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       deleteDirIfExists cfgPath
       deleteDirIfExists logPath
       putStrLn "Deleted configuration and log files"
-    Journal cmd -> withIniFile $ \ini -> do
-      msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
-      msgsFileExists <- doesFileExist storeMsgsFilePath
-      storeLogFile <- getRequiredStoreLogFile ini
-      case cmd of
-        SCImport
-          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
-          | msgsDirExists -> do
-              putStrLn $ storeMsgsJournalDir <> " directory already exists."
-              exitFailure
-          | not msgsFileExists -> do
-              putStrLn $ storeMsgsFilePath <> " file does not exist."
-              exitFailure
-          | otherwise -> do
-              confirmOrExit
-                ("WARNING: message log file " <> storeMsgsFilePath <> " will be imported to journal directory " <> storeMsgsJournalDir)
-                "Messages not imported"
-              ms <- newJournalMsgStore logPath MQStoreCfg
-              readQueueStore True (mkQueue ms False) storeLogFile $ stmQueueStore ms
-              msgStats <- importMessages True ms storeMsgsFilePath Nothing False -- no expiration
-              putStrLn "Import completed"
-              printMessageStats "Messages" msgStats
-              putStrLn $ case readStoreType ini of
-                Right (ASType SQSMemory SMSMemory) -> "store_messages set to `memory`, update it to `journal` in INI file"
-                Right (ASType SQSPostgres SMSPostgres) -> "store_messages set to `database`, update it to `journal` in INI file"
-                Right (ASType _ SMSJournal) -> "store_messages set to `journal`"
-                Left e -> e <> ", configure storage correctly"
-        SCExport
-          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
-          | msgsFileExists -> do
-              putStrLn $ storeMsgsFilePath <> " file already exists."
-              exitFailure
-          | otherwise -> do
-              confirmOrExit
-                ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be exported to message log file " <> storeMsgsFilePath)
-                "Journal not exported"
-              case readStoreType ini of
-                Right (ASType SQSMemory msType) -> do
-                  ms <- newJournalMsgStore logPath MQStoreCfg
-                  readQueueStore True (mkQueue ms False) storeLogFile $ stmQueueStore ms
-                  exportMessages True (StoreJournal ms) storeMsgsFilePath False
-                  putStrLn "Export completed"
-                  putStrLn $ case msType of
-                    SMSMemory -> "store_messages set to `memory`, start the server."
-                    SMSJournal -> "store_messages set to `journal`, update it to `memory` in INI file"
-#if defined(dbServerPostgres)
-                Right (ASType SQSPostgres SMSJournal) -> do
-                  let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
-                      dbOpts@DBOpts {connstr, schema} = iniDBOptions ini defaultDBOpts
-                  unlessM (checkSchemaExists connstr schema) $ do
-                    putStrLn $ "Schema " <> B.unpack schema <> " does not exist in PostrgreSQL database: " <> B.unpack connstr
-                    exitFailure
-                  ms <- newJournalMsgStore logPath $ PQStoreCfg PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
-                  exportMessages True (StoreJournal ms) storeMsgsFilePath False
-                  putStrLn "Export completed"
-                  putStrLn "store_messages set to `journal`, store_queues is set to `database`.\nExport queues to store log to use memory storage for messages (`smp-server database export`)."
-                Right (ASType SQSPostgres SMSPostgres) -> do
-                  putStrLn $ "Messages can be exported with `dabatase export --table messages`."
-                  exitFailure
-#else
-                Right (ASType SQSPostgres SMSJournal) -> noPostgresExit
-#endif
-                Left e -> putStrLn $ e <> ", configure storage correctly"
-        SCDelete
-          | not msgsDirExists -> do
-              putStrLn $ storeMsgsJournalDir <> " directory does not exists."
-              exitFailure
-          | otherwise -> do
-              confirmOrExit
-                ("WARNING: journal directory " <> storeMsgsJournalDir <> " will be permanently deleted.\nTHIS CANNOT BE UNDONE!")
-                "Messages NOT deleted"
-              deleteDirIfExists storeMsgsJournalDir
-              putStrLn $ "Deleted all messages in journal " <> storeMsgsJournalDir
 #if defined(dbServerPostgres)
     Database cmd tables dbOpts@DBOpts {connstr, schema} -> withIniFile $ \ini -> do
       schemaExists <- checkSchemaExists connstr schema
@@ -221,7 +143,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: store log file " <> storeLogFile <> " and message log file " <> storeMsgsFilePath <> " will be imported to PostrgreSQL database: " <> B.unpack connstr <> ", schema: " <> B.unpack schema)
                 "Store logs not imported"
-              (sCnt, qCnt) <- importStoreLogToDatabase logPath storeLogFile dbOpts
+              (sCnt, qCnt) <- importStoreLogToDatabase storeLogFile dbOpts
               putStrLn $ "Imported: " <> show sCnt <> " services, " <> show qCnt <> " queues"
               putStrLn "Importing messages..."
               mCnt <- importMessagesToDatabase storeMsgsFilePath dbOpts
@@ -248,11 +170,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: store log file " <> storeLogFile <> " will be compacted and imported to PostrgreSQL database: " <> B.unpack connstr <> ", schema: " <> B.unpack schema)
                 "Queue records not imported"
-              (sCnt, qCnt) <- importStoreLogToDatabase logPath storeLogFile dbOpts
+              (sCnt, qCnt) <- importStoreLogToDatabase storeLogFile dbOpts
               putStrLn $ "Import completed: " <> show sCnt <> " services, " <> show qCnt <> " queues"
               putStrLn $ case readStoreType ini of
-                Right (ASType SQSMemory SMSMemory) -> setToDbStr <> "\nstore_messages set to `memory`, import messages to journal to use PostgreSQL database for queues (`smp-server journal import`)"
-                Right (ASType SQSMemory SMSJournal) -> setToDbStr
+                Right (ASType SQSMemory SMSMemory) -> setToDbStr <> "\nstore_messages set to `memory`, update it to `database` and import messages (`smp-server database import --table messages`)"
                 Right (ASType SQSPostgres _) -> "store_queues set to `database`, start the server."
                 Left e -> e <> ", configure storage correctly"
           where
@@ -280,7 +201,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: PostrgreSQL schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath <> " and to message log file " <> storeMsgsFilePath)
                 "Database store not exported"
-              (sCnt, qCnt) <- exportDatabaseToStoreLog logPath dbOpts storeLogFilePath
+              (sCnt, qCnt) <- exportDatabaseToStoreLog dbOpts storeLogFilePath
               putStrLn $ "Exported: " <> show sCnt <> " services, " <> show qCnt <> " queues"
               putStrLn "Exporting messages..."
               let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
@@ -306,7 +227,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: PostrgreSQL schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath)
                 "Queue records not exported"
-              (sCnt, qCnt) <- exportDatabaseToStoreLog logPath dbOpts storeLogFilePath
+              (sCnt, qCnt) <- exportDatabaseToStoreLog dbOpts storeLogFilePath
               putStrLn $ "Export completed: " <> show sCnt <> " services, " <> show qCnt <> " queues"
               putStrLn $ case readStoreType ini of
                 Right (ASType SQSPostgres _) -> "store_queues or store_messages set to `database`, update it to `memory` in INI file."
@@ -346,6 +267,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       doesFileExist iniFile >>= \case
         True -> readIniFile iniFile >>= either exitError a
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
+#if defined(dbServerPostgres)
     getRequiredStoreLogFile ini = do
       case enableStoreLog' ini $> storeLogFilePath of
         Just storeLogFile -> do
@@ -354,20 +276,21 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
             (pure storeLogFile)
             (putStrLn ("Store log file " <> storeLogFile <> " not found") >> exitFailure)
         Nothing -> putStrLn "Store log disabled, see `[STORE_LOG] enable`" >> exitFailure
+#endif
     iniFile = combine cfgPath "smp-server.ini"
     serverVersion = "SMP server v" <> simplexmqVersionCommit
     executableName = "smp-server"
     storeLogFilePath = combine logPath "smp-server-store.log"
     storeMsgsFilePath = combine logPath "smp-server-messages.log"
-    storeMsgsJournalDir = storeMsgsJournalDir' logPath
+    storeMsgsJournalDir = combine logPath "messages"
     storeNtfsFilePath = combine logPath "smp-server-ntfs.log"
     readStoreType :: Ini -> Either String AStoreType
     readStoreType ini = case (iniStoreQueues, iniStoreMessage) of
       ("memory", "memory") -> Right $ ASType SQSMemory SMSMemory
-      ("memory", "journal") -> Right $ ASType SQSMemory SMSJournal
+      ("memory", "journal") -> Left journalRemovedStr
       ("memory", "database") -> Left "Database and memory storage are not compatible."
       ("database", "memory") -> Left "Database and memory storage are not compatible."
-      ("database", "journal") -> Right $ ASType SQSPostgres SMSJournal
+      ("database", "journal") -> Left journalRemovedStr
 #if defined(dbServerPostgres)
       ("database", "database") -> Right $ ASType SQSPostgres SMSPostgres
 #else
@@ -377,10 +300,12 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       where
         iniStoreQueues = fromRight "memory" $ lookupValue "STORE_LOG" "store_queues" ini
         iniStoreMessage = fromRight "memory" $ lookupValue "STORE_LOG" "store_messages" ini
+#if defined(dbServerPostgres)
     iniDeletedTTL ini = readIniDefault (86400 * defaultDeletedTTL) "STORE_LOG" "db_deleted_ttl" ini
+    enableDbStoreLog' = settingIsOn "STORE_LOG" "db_store_log"
+#endif
     defaultStaticPath = combine logPath "www"
     enableStoreLog' = settingIsOn "STORE_LOG" "enable"
-    enableDbStoreLog' = settingIsOn "STORE_LOG" "db_store_log"
     initializeServer opts
       | scripted opts = initialize opts
       | otherwise = do
@@ -517,16 +442,13 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
         iniStoreType = either error id $! readStoreType ini
         iniStoreCfg :: SupportedStore qs ms => SQSType qs -> SMSType ms -> ServerStoreCfg (MsgStoreType qs ms)
         iniStoreCfg SQSMemory SMSMemory = SSCMemory $ enableStoreLog' ini $> StorePaths {storeLogFile = storeLogFilePath, storeMsgsFile = restoreMessagesFile storeMsgsFilePath}
-        iniStoreCfg SQSMemory SMSJournal = SSCMemoryJournal {storeLogFile = storeLogFilePath, storeMsgsPath = storeMsgsJournalDir}
-        iniStoreCfg SQSPostgres SMSJournal =
-          let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
-              storeCfg = PostgresStoreCfg {dbOpts = iniDBOptions ini defaultDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
-           in SSCDatabaseJournal {storeCfg, storeMsgsPath' = storeMsgsJournalDir}
 #if defined(dbServerPostgres)
         iniStoreCfg SQSPostgres SMSPostgres =
           let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
               storeCfg = PostgresStoreCfg {dbOpts = iniDBOptions ini defaultDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
            in SSCDatabase storeCfg
+#else
+        iniStoreCfg SQSPostgres _ = error noPostgresExitStr
 #endif
         serverConfig :: ServerStoreCfg s -> ServerConfig s
         serverConfig serverStoreCfg =
@@ -535,8 +457,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               smpHandshakeTimeout = 120000000,
               tbqSize = 128,
               msgQueueQuota = defaultMsgQueueQuota,
-              maxJournalMsgCount = defaultMaxJournalMsgCount,
-              maxJournalStateLines = defaultMaxJournalStateLines,
               queueIdBytes = 24,
               msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
               smpCredentials =
@@ -561,7 +481,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                     },
               expireMessagesOnStart = fromMaybe True $ iniOnOff "STORE_LOG" "expire_messages_on_start" ini,
               expireMessagesOnSend = fromMaybe True $ iniOnOff "STORE_LOG" "expire_messages_on_send" ini,
-              idleQueueInterval = defaultIdleQueueInterval,
               notificationExpiration =
                 defaultNtfExpiration
                   { ttl = 3600 * readIniDefault defNtfExpirationHours "STORE_LOG" "expire_ntfs_hours" ini
@@ -634,47 +553,26 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
         webStaticPath' = eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini
 
     checkMsgStoreMode :: Ini -> AStoreType -> IO ()
+#if defined(dbServerPostgres)
     checkMsgStoreMode ini mode = do
-      msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
-      msgsFileExists <- doesFileExist storeMsgsFilePath
-      storeLogExists <- doesFileExist storeLogFilePath
+#else
+    checkMsgStoreMode _ mode = do
+#endif
+      whenM (doesDirectoryExist storeMsgsJournalDir) $ do
+        putStrLn $ "Error: " <> storeMsgsJournalDir <> " directory is present.\n" <> journalRemovedStr
+        exitFailure
       case mode of
 #if defined(dbServerPostgres)
-        ASType SQSPostgres SMSPostgres
-          | msgsFileExists || msgsDirExists -> do
-              putStrLn $ "Error: " <> storeMsgsFilePath <> " file or " <> storeMsgsJournalDir <> " directory are present."
-              putStrLn "Configure memory storage."
-              exitFailure
-          | otherwise -> checkDbStorage ini storeLogExists
-#endif
-        ASType qs SMSJournal
-          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
-          | msgsFileExists -> do
-              putStrLn $ "Error: store_messages is `journal` with " <> storeMsgsFilePath <> " file present."
-              putStrLn "Set store_messages to `memory` or use `smp-server journal export` to migrate."
-              exitFailure
-          | not msgsDirExists ->
-              putStrLn $ "store_messages is `journal`, " <> storeMsgsJournalDir <> " directory will be created."
-          | otherwise -> case qs of
-              SQSMemory ->
-                unless (storeLogExists) $ putStrLn $ "store_queues is `memory`, " <> storeLogFilePath <> " file will be created."
-#if defined(dbServerPostgres)
-              SQSPostgres -> checkDbStorage ini storeLogExists
+        ASType SQSPostgres SMSPostgres -> do
+          whenM (doesFileExist storeMsgsFilePath) $ do
+            putStrLn $ "Error: " <> storeMsgsFilePath <> " file is present."
+            putStrLn "Configure memory storage."
+            exitFailure
+          checkDbStorage ini =<< doesFileExist storeLogFilePath
 #else
-              SQSPostgres -> noPostgresExit
+        ASType SQSPostgres _ -> noPostgresExit
 #endif
-        ASType SQSMemory SMSMemory
-          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
-          | msgsDirExists -> do
-              putStrLn $ "Error: store_messages is `memory` with " <> storeMsgsJournalDir <> " directory present."
-              putStrLn "Set store_messages to `journal` or use `smp-server journal import` to migrate."
-              exitFailure
-          | otherwise -> pure ()
-
-    exitConfigureMsgStorage = do
-      putStrLn $ "Error: both " <> storeMsgsFilePath <> " file and " <> storeMsgsJournalDir <> " directory are present."
-      putStrLn "Configure memory storage."
-      exitFailure
+        ASType SQSMemory SMSMemory -> pure ()
 
 #if defined(dbServerPostgres)
     checkDbStorage ini storeLogExists = do
@@ -705,18 +603,18 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       putStrLn "Configure queue storage."
       exitFailure
 
-importStoreLogToDatabase :: FilePath -> FilePath -> DBOpts -> IO (Int64, Int64)
-importStoreLogToDatabase logPath storeLogFile dbOpts = do
-  ms <- newJournalMsgStore logPath MQStoreCfg
-  let st = stmQueueStore ms
-  sl <- readWriteQueueStore True (mkQueue ms False) storeLogFile st
+importStoreLogToDatabase :: FilePath -> DBOpts -> IO (Int64, Int64)
+importStoreLogToDatabase storeLogFile dbOpts = do
+  ms <- newMsgStore STMStoreConfig {storePath = Nothing, quota = defaultMsgQueueQuota}
+  let st = queueStore ms
+  sl <- readWriteQueueStore True (mkQueue ms) storeLogFile st
   closeStoreLog sl
-  queues <- readTVarIO $ loadedQueues st
+  qs <- readTVarIO $ queues st
   services' <- M.elems <$> readTVarIO (services st)
   let storeCfg = PostgresStoreCfg {dbOpts = dbOpts {createSchema = True}, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
-  ps <- newJournalMsgStore logPath $ PQStoreCfg storeCfg
-  sCnt <- batchInsertServices services' $ postgresQueueStore ps
-  qCnt <- batchInsertQueues @(JournalQueue 'QSMemory) True queues $ postgresQueueStore ps
+  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue storeCfg
+  sCnt <- batchInsertServices services' ps
+  qCnt <- batchInsertQueues True qs ps
   renameFile storeLogFile $ storeLogFile <> ".bak"
   pure (sCnt, qCnt)
 
@@ -735,24 +633,22 @@ importMessagesToDatabase msgsLogFile dbOpts = do
   renameFile msgsLogFile $ msgsLogFile <> ".bak"
   pure mCnt'
 
-exportDatabaseToStoreLog :: FilePath -> DBOpts -> FilePath -> IO (Int, Int)
-exportDatabaseToStoreLog logPath dbOpts storeLogFilePath = do
+exportDatabaseToStoreLog :: DBOpts -> FilePath -> IO (Int, Int)
+exportDatabaseToStoreLog dbOpts storeLogFilePath = do
   let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
-  ps <- newJournalMsgStore logPath $ PQStoreCfg storeCfg
+  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue storeCfg
   sl <- openWriteStoreLog False storeLogFilePath
-  Sum sCnt <- foldServiceRecs (postgresQueueStore ps) $ \sr -> logNewService sl sr $> Sum (1 :: Int)
-  Sum qCnt <- foldQueueRecs True True (postgresQueueStore ps) $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
+  Sum sCnt <- foldServiceRecs ps $ \sr -> logNewService sl sr $> Sum (1 :: Int)
+  Sum qCnt <- foldQueueRecs True True ps $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
   closeStoreLog sl
   pure (sCnt, qCnt)
 #endif
 
-newJournalMsgStore :: FilePath -> QStoreCfg s -> IO (JournalMsgStore s)
-newJournalMsgStore logPath qsCfg =
-  let cfg = mkJournalStoreConfig qsCfg (storeMsgsJournalDir' logPath) defaultMsgQueueQuota defaultMaxJournalMsgCount defaultMaxJournalStateLines $ checkInterval defaultMessageExpiration
-   in newMsgStore cfg
-
-storeMsgsJournalDir' :: FilePath -> FilePath
-storeMsgsJournalDir' logPath = combine logPath "messages"
+journalRemovedStr :: String
+journalRemovedStr =
+  "Journal message storage is removed.\n"
+    <> "Export messages with `smp-server journal export` using smp-server v7.1.0.10 or earlier,\n"
+    <> "then set store_messages to `memory`, or to `database` and run `smp-server database import --table messages`."
 
 getServerSourceCode :: IO (Maybe String)
 getServerSourceCode =
@@ -873,7 +769,6 @@ data CliCommand
   | OnlineCert CertOptions
   | Start StartOptions
   | Delete
-  | Journal StoreCmd
   | Database StoreCmd DatabaseTable DBOpts
 
 data StoreCmd = SCImport | SCExport | SCDelete
@@ -899,7 +794,6 @@ cliCommandP cfgPath logPath iniFile =
         <> command "cert" (info (OnlineCert <$> certOptionsP) (progDesc $ "Generate new online TLS server credentials (configuration: " <> iniFile <> ")"))
         <> command "start" (info (Start <$> startOptionsP) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
         <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
-        <> command "journal" (info (Journal <$> journalCmdP) (progDesc "Import/export messages to/from journal storage"))
         <> command "database" (info (Database <$> databaseCmdP <*> dbTableP <*> dbOptsP defaultDBOpts) (progDesc "Import/export queues to/from PostgreSQL database storage"))
     )
   where
@@ -1046,7 +940,6 @@ cliCommandP cfgPath logPath iniFile =
             disableWeb,
             scripted
           }
-    journalCmdP = storeCmdP "message log file" "journal storage"
     databaseCmdP = storeCmdP "queue store log file" "PostgreSQL database schema"
     storeCmdP src dest =
       hsubparser

src/Simplex/Messaging/Server/Main/Init.hs

@@ -83,7 +83,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
     <> ("enable = " <> onOff enableStoreLog <> "\n\n")
     <> "# Queue storage mode: `memory` or `database` (to store queue records in PostgreSQL database).\n\
         \# `memory` - in-memory persistence, with optional append-only log (`enable = on`).\n\
-        \# `database`- PostgreSQL databass (requires `store_messages = journal`).\n\
+        \# `database`- PostgreSQL databass (requires `store_messages = database`).\n\
         \store_queues = memory\n\n\
         \# Database connection settings for PostgreSQL database (`store_queues = database`).\n"
     <> iniDbOpts dbOptions defaultDBOpts
@@ -91,7 +91,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
         \# db_store_log = off\n\n\
         \# Time to retain deleted queues in the database, days.\n"
     <> ("# db_deleted_ttl = " <> tshow defaultDeletedTTL <> "\n\n")
-    <> "# Message storage mode: `memory` or `journal`.\n\
+    <> "# Message storage mode: `memory` or `database` (requires `store_queues = database`).\n\
         \store_messages = memory\n\n\
         \# When store_messages is `memory`, undelivered messages are optionally saved and restored\n\
         \# when the server restarts, they are preserved in the .bak file until the next restart.\n"

src/Simplex/Messaging/Server/MsgStore/Journal/SharedLock.hs

@@ -1,44 +0,0 @@
-module Simplex.Messaging.Server.MsgStore.Journal.SharedLock
-  ( withLockWaitShared,
-    withLockMapWaitShared,
-    withSharedWaitLock,
-  )
-where
-
-import Control.Concurrent.STM
-import qualified Control.Exception as E
-import Control.Monad
-import Data.Text (Text)
-import Simplex.Messaging.Agent.Lock
-import Simplex.Messaging.Agent.Client (getMapLock)
-import Simplex.Messaging.Protocol (RecipientId)
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (($>>), ($>>=))
-
--- wait until shared lock with passed ID is released and take lock
-withLockWaitShared :: RecipientId -> Lock -> TMVar RecipientId -> Text -> IO a -> IO a
-withLockWaitShared rId lock shared name =
-  E.bracket_
-    (atomically $ waitShared rId shared >> putTMVar lock name)
-    (void $ atomically $ takeTMVar lock)
-
--- wait until shared lock with passed ID is released and take lock from Map for this ID
-withLockMapWaitShared :: RecipientId -> TMap RecipientId Lock -> TMVar RecipientId -> Text -> IO a -> IO a
-withLockMapWaitShared rId locks shared name a =
-  E.bracket
-    (atomically $ waitShared rId shared >> getPutLock (getMapLock locks) rId name)
-    (atomically . takeTMVar)
-    (const a)
-
-waitShared :: RecipientId -> TMVar RecipientId -> STM ()
-waitShared rId shared = tryReadTMVar shared >>= mapM_ (\rId' -> when (rId == rId') retry)
-
--- wait until lock with passed ID in Map is released and take shared lock for this ID
-withSharedWaitLock :: RecipientId -> TMap RecipientId Lock -> TMVar RecipientId -> IO a -> IO a
-withSharedWaitLock rId locks shared =
-  E.bracket_
-    (atomically $ waitLock >> putTMVar shared rId)
-    (atomically $ takeTMVar shared)
-  where
-    waitLock = TM.lookup rId locks $>>= tryReadTMVar $>> retry

src/Simplex/Messaging/Server/MsgStore/Postgres.hs

@@ -29,7 +29,6 @@ where
 import Control.Concurrent.STM
 import qualified Control.Exception as E
 import Control.Monad
-import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as BB
@@ -39,7 +38,6 @@ import Data.IORef
 import Data.Int (Int64)
 import Data.List (intersperse)
 import qualified Data.Map.Strict as M
-import Data.Text (Text)
 import Data.Time.Clock.System (SystemTime (..))
 import Database.PostgreSQL.Simple (Binary (..), In (..), Only (..), (:.) (..))
 import qualified Database.PostgreSQL.Simple as DB
@@ -56,7 +54,7 @@ import Simplex.Messaging.Server.QueueStore.Postgres
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog (foldLogLines)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Util (maybeFirstRow, maybeFirstRow', (<$$>))
+import Simplex.Messaging.Util (maybeFirstRow, maybeFirstRow')
 import System.IO (Handle, hFlush, stdout)
 
 data PostgresMsgStore = PostgresMsgStore
@@ -81,34 +79,20 @@ instance StoreQueueClass PostgresQueue where
   {-# INLINE recipientId #-}
   queueRec = queueRec'
   {-# INLINE queueRec #-}
-  withQueueLock PostgresQueue {} _ = id -- TODO [messages] maybe it's just transaction?
-  {-# INLINE withQueueLock #-}
-  removeQueueLock _ = pure ()
-  {-# INLINE removeQueueLock #-}
-
-newtype DBTransaction = DBTransaction {dbConn :: DB.Connection}
-
-type DBStoreIO a = ReaderT DBTransaction IO a
 
 instance MsgStoreClass PostgresMsgStore where
-  type StoreMonad PostgresMsgStore = ReaderT DBTransaction IO
-  type MsgQueue PostgresMsgStore = ()
   type QueueStore PostgresMsgStore = PostgresQueueStore'
   type StoreQueue PostgresMsgStore = PostgresQueue
   type MsgStoreConfig PostgresMsgStore = PostgresMsgStoreCfg
 
   newMsgStore :: PostgresMsgStoreCfg -> IO PostgresMsgStore
   newMsgStore config = do
-    queueStore_ <- newQueueStore @PostgresQueue (queueStoreCfg config, False)
+    queueStore_ <- newQueueStore @PostgresQueue (queueStoreCfg config)
     pure PostgresMsgStore {config, queueStore_}
 
   closeMsgStore :: PostgresMsgStore -> IO ()
   closeMsgStore = closeQueueStore @PostgresQueue . queueStore_
 
-  withActiveMsgQueues _ _ = error "withActiveMsgQueues not used"
-
-  unsafeWithAllMsgQueues _ _ _ = error "unsafeWithAllMsgQueues not used"
-
   expireOldMessages :: Bool -> PostgresMsgStore -> Int64 -> Int64 -> IO MessageStats
   expireOldMessages _tty ms now ttl =
     maybeFirstRow' newMessageStats toMessageStats $ withConnection st $ \db ->
@@ -152,35 +136,13 @@ instance MsgStoreClass PostgresMsgStore where
             msg_ = toMaybeMessage mRow
          in f a rId $ Right ((qr,) <$> msg_)
 
-  logQueueStates _ = error "logQueueStates not used"
-
-  logQueueState _ = error "logQueueState not used"
-
   queueStore = queueStore_
   {-# INLINE queueStore #-}
 
-  loadedQueueCounts :: PostgresMsgStore -> IO LoadedQueueCounts
-  loadedQueueCounts ms = do
-    loadedQueueCount <- M.size <$> readTVarIO queues
-    loadedNotifierCount <- M.size <$> readTVarIO notifiers
-    notifierLockCount <- M.size <$> readTVarIO notifierLocks
-    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, openJournalCount = 0, queueLockCount = 0, notifierLockCount}
-    where
-      PostgresQueueStore {queues, notifiers, notifierLocks} = queueStore_ ms
-
-  mkQueue :: PostgresMsgStore -> Bool -> RecipientId -> QueueRec -> IO PostgresQueue
-  mkQueue _ _keepLock rId qr = PostgresQueue rId <$> newTVarIO (Just qr)
+  mkQueue :: PostgresMsgStore -> RecipientId -> QueueRec -> IO PostgresQueue
+  mkQueue _ rId qr = PostgresQueue rId <$> newTVarIO (Just qr)
   {-# INLINE mkQueue #-}
 
-  getMsgQueue _ _ _ = pure ()
-  {-# INLINE getMsgQueue #-}
-
-  getPeekMsgQueue :: PostgresMsgStore -> PostgresQueue -> DBStoreIO (Maybe ((), Message))
-  getPeekMsgQueue _ q = ((),) <$$> tryPeekMsg_ q ()
-
-  withIdleMsgQueue :: Int64 -> PostgresMsgStore -> PostgresQueue -> (() -> DBStoreIO a) -> DBStoreIO (Maybe a, Int)
-  withIdleMsgQueue _ _ _ _ = error "withIdleMsgQueue not used"
-
   deleteQueue :: PostgresMsgStore -> PostgresQueue -> IO (Either ErrorType QueueRec)
   deleteQueue ms q = deleteStoreQueue (queueStore_ ms) q
   {-# INLINE deleteQueue #-}
@@ -191,8 +153,6 @@ instance MsgStoreClass PostgresMsgStore where
     qr <- ExceptT $ deleteStoreQueue (queueStore_ ms) q
     pure (qr, size)
 
-  getQueueMessages_ _ _ _ = error "getQueueMessages_ not used"
-
   writeMsg :: PostgresMsgStore -> PostgresQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
   writeMsg ms q _ msg =
     uninterruptibleMask_ $
@@ -211,43 +171,26 @@ instance MsgStoreClass PostgresMsgStore where
         [] -> Nothing
       PostgresMsgStore {config = PostgresMsgStoreCfg {quota}} = ms
 
-  setOverQuota_ :: PostgresQueue -> IO () -- can ONLY be used while restoring messages, not while server running
-  setOverQuota_ _ = error "TODO setOverQuota_" -- TODO [messages]
-
-  getQueueSize_ :: () -> DBStoreIO Int
-  getQueueSize_ _ = error "getQueueSize_ not used"
-
   getQueueSize :: PostgresMsgStore -> PostgresQueue -> ExceptT ErrorType IO Int
   getQueueSize ms q =
     withDB' "getQueueSize" (queueStore_ ms) $ \db ->
       maybeFirstRow' 0 fromOnly $
         DB.query db "SELECT msg_queue_size FROM msg_queues WHERE recipient_id = ? AND deleted_at IS NULL" (Only (recipientId' q))
 
-  tryPeekMsg_ :: PostgresQueue -> () -> DBStoreIO (Maybe Message)
-  tryPeekMsg_ q _ = do
-    db <- asks dbConn
-    liftIO $ maybeFirstRow toMessage $
-      DB.query
-        db
-        [sql|
-          SELECT msg_id, msg_ts, msg_quota, msg_ntf_flag, msg_body
-          FROM messages
-          WHERE recipient_id = ?
-          ORDER BY message_id ASC LIMIT 1
-        |]
-        (Only (recipientId' q))
-
-  tryDeleteMsg_ :: PostgresQueue -> () -> Bool -> DBStoreIO ()
-  tryDeleteMsg_ _q _ _ = error "tryDeleteMsg_ not used" -- do
-
-  isolateQueue :: PostgresMsgStore -> PostgresQueue -> Text -> DBStoreIO a -> ExceptT ErrorType IO a
-  isolateQueue ms _q op a = uninterruptibleMask_ $ withDB' op (queueStore_ ms) $ runReaderT a . DBTransaction
-
-  unsafeRunStore _ _ _ = error "unsafeRunStore not used"
-
   tryPeekMsg :: PostgresMsgStore -> PostgresQueue -> ExceptT ErrorType IO (Maybe Message)
-  tryPeekMsg ms q = isolateQueue ms q "tryPeekMsg" $ tryPeekMsg_ q ()
-  {-# INLINE tryPeekMsg #-}
+  tryPeekMsg ms q =
+    uninterruptibleMask_ $
+      withDB' "tryPeekMsg" (queueStore_ ms) $ \db ->
+        maybeFirstRow toMessage $
+          DB.query
+            db
+            [sql|
+              SELECT msg_id, msg_ts, msg_quota, msg_ntf_flag, msg_body
+              FROM messages
+              WHERE recipient_id = ?
+              ORDER BY message_id ASC LIMIT 1
+            |]
+            (Only (recipientId' q))
 
   tryPeekMsgs :: PostgresMsgStore -> [PostgresQueue] -> ExceptT ErrorType IO (M.Map RecipientId Message)
   tryPeekMsgs _ms [] = pure M.empty

src/Simplex/Messaging/Server/MsgStore/STM.hs

@@ -15,6 +15,10 @@ module Simplex.Messaging.Server.MsgStore.STM
   ( STMMsgStore (..),
     STMStoreConfig (..),
     STMQueue,
+    loadedQueueCounts,
+    getQueueMessages,
+    setOverQuota_,
+    deleteQuotaMsg,
   )
 where
 
@@ -24,7 +28,8 @@ import Control.Monad.Trans.Except
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.Map.Strict as M
-import Data.Text (Text)
+import Data.Maybe (catMaybes)
+import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
@@ -61,14 +66,8 @@ instance StoreQueueClass STMQueue where
   {-# INLINE recipientId #-}
   queueRec = queueRec'
   {-# INLINE queueRec #-}
-  withQueueLock _ _ = id
-  {-# INLINE withQueueLock #-}
-  removeQueueLock _ = pure ()
-  {-# INLINE removeQueueLock #-}
 
 instance MsgStoreClass STMMsgStore where
-  type StoreMonad STMMsgStore = STM
-  type MsgQueue STMMsgStore = STMMsgQueue
   type QueueStore STMMsgStore = STMQueueStore STMQueue
   type StoreQueue STMMsgStore = STMQueue
   type MsgStoreConfig STMMsgStore = STMStoreConfig
@@ -80,59 +79,22 @@ instance MsgStoreClass STMMsgStore where
 
   closeMsgStore = closeQueueStore @STMQueue . queueStore_
   {-# INLINE closeMsgStore #-}
-  withActiveMsgQueues = withLoadedQueues . queueStore_
-  {-# INLINE withActiveMsgQueues #-}
-  unsafeWithAllMsgQueues _ = withLoadedQueues . queueStore_
-  {-# INLINE unsafeWithAllMsgQueues #-}
 
   expireOldMessages :: Bool -> STMMsgStore -> Int64 -> Int64 -> IO MessageStats
   expireOldMessages _tty ms now ttl =
-    withLoadedQueues (queueStore_ ms) $ atomically . expireQueueMsgs ms now (now - ttl)
+    withLoadedQueues (queueStore_ ms) $ atomically . expireQueueMsgs (now - ttl)
 
   foldRcvServiceMessages :: STMMsgStore -> ServiceId -> (a -> RecipientId -> Either ErrorType (Maybe (QueueRec, Message)) -> IO a) -> a -> IO (Either ErrorType a)
   foldRcvServiceMessages ms serviceId f = fmap Right . foldRcvServiceQueues (queueStore_ ms) serviceId f'
     where
       f' a (q, qr) = runExceptT (tryPeekMsg ms q) >>= f a (recipientId q) . ((qr,) <$$>)
 
-  logQueueStates _ = pure ()
-  {-# INLINE logQueueStates #-}
-  logQueueState _ = pure ()
-  {-# INLINE logQueueState #-}
   queueStore = queueStore_
   {-# INLINE queueStore #-}
 
-  loadedQueueCounts :: STMMsgStore -> IO LoadedQueueCounts
-  loadedQueueCounts STMMsgStore {queueStore_ = st} = do
-    loadedQueueCount <- M.size <$> readTVarIO (queues st)
-    loadedNotifierCount <- M.size <$> readTVarIO (notifiers st)
-    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, openJournalCount = 0, queueLockCount = 0, notifierLockCount = 0}
-
-  mkQueue _ _ rId qr = STMQueue rId <$> newTVarIO (Just qr) <*> newTVarIO Nothing
+  mkQueue _ rId qr = STMQueue rId <$> newTVarIO (Just qr) <*> newTVarIO Nothing
   {-# INLINE mkQueue #-}
 
-  getMsgQueue :: STMMsgStore -> STMQueue -> Bool -> STM STMMsgQueue
-  getMsgQueue _ STMQueue {msgQueue'} _ = readTVar msgQueue' >>= maybe newQ pure
-    where
-      newQ = do
-        msgTQueue <- newTQueue
-        canWrite <- newTVar True
-        size <- newTVar 0
-        let q = STMMsgQueue {msgTQueue, canWrite, size}
-        writeTVar msgQueue' (Just q)
-        pure q
-
-  getPeekMsgQueue :: STMMsgStore -> STMQueue -> STM (Maybe (STMMsgQueue, Message))
-  getPeekMsgQueue _ q@STMQueue {msgQueue'} = readTVar msgQueue' $>>= \mq -> (mq,) <$$> tryPeekMsg_ q mq
-
-  -- does not create queue if it does not exist, does not delete it if it does (can't just close in-memory queue)
-  withIdleMsgQueue :: Int64 -> STMMsgStore -> STMQueue -> (STMMsgQueue -> STM a) -> STM (Maybe a, Int)
-  withIdleMsgQueue _ _ STMQueue {msgQueue'} action = readTVar msgQueue' >>= \case
-    Just q -> do
-      r <- action q
-      sz <- getQueueSize_ q
-      pure (Just r, sz)
-    Nothing -> pure (Nothing, 0)
-
   deleteQueue :: STMMsgStore -> STMQueue -> IO (Either ErrorType QueueRec)
   deleteQueue ms q = fst <$$> deleteQueue_ ms q
 
@@ -142,17 +104,9 @@ instance MsgStoreClass STMMsgStore where
     where
       getSize = maybe (pure 0) (\STMMsgQueue {size} -> readTVarIO size)
 
-  getQueueMessages_ :: Bool -> STMQueue -> STMMsgQueue -> STM [Message]
-  getQueueMessages_ drainMsgs _ = (if drainMsgs then flushTQueue else snapshotTQueue) . msgTQueue
-    where
-      snapshotTQueue q = do
-        msgs <- flushTQueue q
-        mapM_ (writeTQueue q) msgs
-        pure msgs
-
   writeMsg :: STMMsgStore -> STMQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
   writeMsg ms q' _logState msg = liftIO $ atomically $ do
-    STMMsgQueue {msgTQueue = q, canWrite, size} <- getMsgQueue ms q' True
+    STMMsgQueue {msgTQueue = q, canWrite, size} <- getMsgQueue q'
     canWrt <- readTVar canWrite
     empty <- isEmptyTQueue q
     if canWrt || empty
@@ -168,29 +122,109 @@ instance MsgStoreClass STMMsgStore where
       STMMsgStore {storeConfig = STMStoreConfig {quota}} = ms
       msgQuota = MessageQuota {msgId = messageId msg, msgTs = messageTs msg}
 
-  setOverQuota_ :: STMQueue -> IO ()
-  setOverQuota_ q = readTVarIO (msgQueue' q) >>= mapM_ (\mq -> atomically $ writeTVar (canWrite mq) False)
+  tryPeekMsg :: STMMsgStore -> STMQueue -> ExceptT ErrorType IO (Maybe Message)
+  tryPeekMsg _ q = snd <$$> withPeekMsgQueue q pure
+  {-# INLINE tryPeekMsg #-}
 
-  getQueueSize_ :: STMMsgQueue -> STM Int
-  getQueueSize_ STMMsgQueue {size} = readTVar size
+  tryPeekMsgs :: STMMsgStore -> [STMQueue] -> ExceptT ErrorType IO (M.Map RecipientId Message)
+  tryPeekMsgs st qs = M.fromList . catMaybes <$> mapM (\q -> (recipientId q,) <$$> tryPeekMsg st q) qs
 
-  tryPeekMsg_ :: STMQueue -> STMMsgQueue -> STM (Maybe Message)
-  tryPeekMsg_ _ = tryPeekTQueue . msgTQueue
-  {-# INLINE tryPeekMsg_ #-}
+  tryDelMsg :: STMMsgStore -> STMQueue -> MsgId -> ExceptT ErrorType IO (Maybe Message)
+  tryDelMsg _ q msgId' =
+    withPeekMsgQueue q $
+      maybe (pure Nothing) $ \(mq, msg) ->
+        if messageId msg == msgId'
+          then tryDeleteMsg_ mq $> Just msg
+          else pure Nothing
 
-  tryDeleteMsg_ :: STMQueue -> STMMsgQueue -> Bool -> STM ()
-  tryDeleteMsg_ _ STMMsgQueue {msgTQueue = q, size} _logState =
-    tryReadTQueue q >>= \case
-      Just _ -> modifyTVar' size (subtract 1)
-      _ -> pure ()
+  tryDelPeekMsg :: STMMsgStore -> STMQueue -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
+  tryDelPeekMsg _ q msgId' =
+    withPeekMsgQueue q $
+      maybe (pure (Nothing, Nothing)) $ \(mq, msg) ->
+        if messageId msg == msgId'
+          then (Just msg,) <$> (tryDeleteMsg_ mq >> tryPeekMsg_ mq)
+          else pure (Nothing, Just msg)
 
-  isolateQueue :: STMMsgStore -> STMQueue -> Text -> STM a -> ExceptT ErrorType IO a
-  isolateQueue _ _ _ = liftIO . atomically
-  {-# INLINE isolateQueue #-}
+  deleteExpiredMsgs :: STMMsgStore -> STMQueue -> Int64 -> ExceptT ErrorType IO Int
+  deleteExpiredMsgs _ q old = liftIO $ atomically $ getMsgQueue q >>= deleteExpireMsgs_ old
 
-  unsafeRunStore :: STMQueue -> Text -> STM a -> IO a
-  unsafeRunStore _ _ = atomically
-  {-# INLINE unsafeRunStore #-}
+  getQueueSize :: STMMsgStore -> STMQueue -> ExceptT ErrorType IO Int
+  getQueueSize _ q = withPeekMsgQueue q $ maybe (pure 0) (getQueueSize_ . fst)
+  {-# INLINE getQueueSize #-}
+
+loadedQueueCounts :: STMMsgStore -> IO LoadedQueueCounts
+loadedQueueCounts STMMsgStore {queueStore_ = st} = do
+  loadedQueueCount <- M.size <$> readTVarIO (queues st)
+  loadedNotifierCount <- M.size <$> readTVarIO (notifiers st)
+  pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount}
+
+getMsgQueue :: STMQueue -> STM STMMsgQueue
+getMsgQueue STMQueue {msgQueue'} = readTVar msgQueue' >>= maybe newQ pure
+  where
+    newQ = do
+      msgTQueue <- newTQueue
+      canWrite <- newTVar True
+      size <- newTVar 0
+      let q = STMMsgQueue {msgTQueue, canWrite, size}
+      writeTVar msgQueue' (Just q)
+      pure q
+
+-- The action is called with Nothing when it is known that the queue is empty
+withPeekMsgQueue :: STMQueue -> (Maybe (STMMsgQueue, Message) -> STM a) -> ExceptT ErrorType IO a
+withPeekMsgQueue STMQueue {msgQueue'} a =
+  liftIO $ atomically $ (readTVar msgQueue' $>>= \mq -> (mq,) <$$> tryPeekMsg_ mq) >>= a
+
+getQueueMessages :: Bool -> STMQueue -> IO [Message]
+getQueueMessages drainMsgs q = atomically $ (if drainMsgs then flushTQueue else snapshotTQueue) . msgTQueue =<< getMsgQueue q
+  where
+    snapshotTQueue mq = do
+      msgs <- flushTQueue mq
+      mapM_ (writeTQueue mq) msgs
+      pure msgs
+
+-- can ONLY be used while restoring messages, not while server running
+setOverQuota_ :: STMQueue -> IO ()
+setOverQuota_ q = readTVarIO (msgQueue' q) >>= mapM_ (\mq -> atomically $ writeTVar (canWrite mq) False)
+
+-- if the first message in queue head is "quota", remove it
+deleteQuotaMsg :: STMQueue -> ExceptT ErrorType IO ()
+deleteQuotaMsg q =
+  withPeekMsgQueue q $ \case
+    Just (mq, MessageQuota {}) -> tryDeleteMsg_ mq
+    _ -> pure ()
+
+expireQueueMsgs :: Int64 -> STMQueue -> STM MessageStats
+expireQueueMsgs old STMQueue {msgQueue'} =
+  readTVar msgQueue' >>= \case
+    Just mq -> do
+      expiredMsgsCount <- deleteExpireMsgs_ old mq
+      storedMsgsCount <- getQueueSize_ mq
+      pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
+    -- does not create queue if it does not exist
+    Nothing -> pure newMessageStats {storedQueues = 1}
+
+deleteExpireMsgs_ :: Int64 -> STMMsgQueue -> STM Int
+deleteExpireMsgs_ old mq = loop 0
+  where
+    loop dc =
+      tryPeekMsg_ mq >>= \case
+        Just Message {msgTs}
+          | systemSeconds msgTs < old ->
+              tryDeleteMsg_ mq >> loop (dc + 1)
+        _ -> pure dc
+
+getQueueSize_ :: STMMsgQueue -> STM Int
+getQueueSize_ STMMsgQueue {size} = readTVar size
+
+tryPeekMsg_ :: STMMsgQueue -> STM (Maybe Message)
+tryPeekMsg_ = tryPeekTQueue . msgTQueue
+{-# INLINE tryPeekMsg_ #-}
+
+tryDeleteMsg_ :: STMMsgQueue -> STM ()
+tryDeleteMsg_ STMMsgQueue {msgTQueue = q, size} =
+  tryReadTQueue q >>= \case
+    Just _ -> modifyTVar' size (subtract 1)
+    _ -> pure ()
 
 deleteQueue_ :: STMMsgStore -> STMQueue -> IO (Either ErrorType (QueueRec, Maybe STMMsgQueue))
 deleteQueue_ ms q = deleteStoreQueue (queueStore_ ms) q >>= mapM remove

src/Simplex/Messaging/Server/MsgStore/Types.hs

@@ -4,17 +4,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Redundant multi-way if" #-}
-
 module Simplex.Messaging.Server.MsgStore.Types
   ( MsgStoreClass (..),
     MSType (..),
@@ -30,107 +25,49 @@ module Simplex.Messaging.Server.MsgStore.Types
     getQueues,
     getQueueRecs,
     readQueueRec,
-    withPeekMsgQueue,
-    expireQueueMsgs,
-    deleteExpireMsgs_,
   ) where
 
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Trans.Except
-import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Kind
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe)
-import Data.Text (Text)
-import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.Types
-import Simplex.Messaging.Util ((<$$>), ($>>=))
+import Simplex.Messaging.Util (($>>=))
 
-class (Monad (StoreMonad s), QueueStoreClass (StoreQueue s) (QueueStore s)) => MsgStoreClass s where
-  type StoreMonad s = (m :: Type -> Type) | m -> s
+class QueueStoreClass (StoreQueue s) (QueueStore s) => MsgStoreClass s where
   type MsgStoreConfig s = c | c -> s
-  type MsgQueue s = q | q -> s
   type StoreQueue s = q | q -> s
   type QueueStore s = qs | qs -> s
   newMsgStore :: MsgStoreConfig s -> IO s
   closeMsgStore :: s -> IO ()
-  withActiveMsgQueues :: Monoid a => s -> (StoreQueue s -> IO a) -> IO a
-  -- This function can only be used in server CLI commands or before server is started.
-  -- tty, store
-  unsafeWithAllMsgQueues :: Monoid a => Bool -> s -> (StoreQueue s -> IO a) -> IO a
   -- tty, store, now, ttl
   expireOldMessages :: Bool -> s -> Int64 -> Int64 -> IO MessageStats
   foldRcvServiceMessages :: s -> ServiceId -> (a -> RecipientId -> Either ErrorType (Maybe (QueueRec, Message)) -> IO a) -> a -> IO (Either ErrorType a)
-  logQueueStates :: s -> IO ()
-  logQueueState :: StoreQueue s -> StoreMonad s ()
   queueStore :: s -> QueueStore s
-  loadedQueueCounts :: s -> IO LoadedQueueCounts
 
   -- message store methods
-  mkQueue :: s -> Bool -> RecipientId -> QueueRec -> IO (StoreQueue s)
-  getMsgQueue :: s -> StoreQueue s -> Bool -> StoreMonad s (MsgQueue s)
-  getPeekMsgQueue :: s -> StoreQueue s -> StoreMonad s (Maybe (MsgQueue s, Message))
-
-  -- the journal queue will be closed after action if it was initially closed or idle longer than interval in config
-  withIdleMsgQueue :: Int64 -> s -> StoreQueue s -> (MsgQueue s -> StoreMonad s a) -> StoreMonad s (Maybe a, Int)
+  mkQueue :: s -> RecipientId -> QueueRec -> IO (StoreQueue s)
   deleteQueue :: s -> StoreQueue s -> IO (Either ErrorType QueueRec)
   deleteQueueSize :: s -> StoreQueue s -> IO (Either ErrorType (QueueRec, Int))
-  getQueueMessages_ :: Bool -> StoreQueue s -> MsgQueue s -> StoreMonad s [Message]
   writeMsg :: s -> StoreQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  setOverQuota_ :: StoreQueue s -> IO () -- can ONLY be used while restoring messages, not while server running
-  getQueueSize_ :: MsgQueue s -> StoreMonad s Int
-  tryPeekMsg_ :: StoreQueue s -> MsgQueue s -> StoreMonad s (Maybe Message)
-  tryDeleteMsg_ :: StoreQueue s -> MsgQueue s -> Bool -> StoreMonad s ()
-  isolateQueue :: s -> StoreQueue s -> Text -> StoreMonad s a -> ExceptT ErrorType IO a
-  unsafeRunStore :: StoreQueue s -> Text -> StoreMonad s a -> IO a
-
-  -- default implementations are overridden for PostgreSQL storage of messages
   tryPeekMsg :: s -> StoreQueue s -> ExceptT ErrorType IO (Maybe Message)
-  tryPeekMsg st q = snd <$$> withPeekMsgQueue st q "tryPeekMsg" pure
-  {-# INLINE tryPeekMsg #-}
-  
   tryPeekMsgs :: s -> [StoreQueue s] -> ExceptT ErrorType IO (Map RecipientId Message)
-  tryPeekMsgs st qs = M.fromList . catMaybes <$> mapM (\q -> (recipientId q,) <$$> tryPeekMsg st q) qs
-
   tryDelMsg :: s -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
-  tryDelMsg st q msgId' =
-    withPeekMsgQueue st q "tryDelMsg" $
-      maybe (pure Nothing) $ \(mq, msg) ->
-        if
-          | messageId msg == msgId' ->
-              tryDeleteMsg_ q mq True $> Just msg
-          | otherwise -> pure Nothing
-
   -- atomic delete (== read) last and peek next message if available
   tryDelPeekMsg :: s -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
-  tryDelPeekMsg st q msgId' =
-    withPeekMsgQueue st q "tryDelPeekMsg" $
-      maybe (pure (Nothing, Nothing)) $ \(mq, msg) ->
-        if
-          | messageId msg == msgId' -> (Just msg,) <$> (tryDeleteMsg_ q mq True >> tryPeekMsg_ q mq)
-          | otherwise -> pure (Nothing, Just msg)
-
   deleteExpiredMsgs :: s -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
-  deleteExpiredMsgs st q old =
-    isolateQueue st q "deleteExpiredMsgs" $
-      getMsgQueue st q False >>= deleteExpireMsgs_ old q
-
   getQueueSize :: s -> StoreQueue s -> ExceptT ErrorType IO Int
-  getQueueSize st q = withPeekMsgQueue st q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)
-  {-# INLINE getQueueSize #-}
 
-data MSType = MSMemory | MSJournal | MSPostgres
+data MSType = MSMemory | MSPostgres
 
 data QSType = QSMemory | QSPostgres
 
 data SMSType :: MSType -> Type where
   SMSMemory :: SMSType 'MSMemory
-  SMSJournal :: SMSType 'MSJournal
   SMSPostgres :: SMSType 'MSPostgres
 
 data SQSType :: QSType -> Type where
@@ -154,17 +91,14 @@ instance Semigroup MessageStats where
 
 data LoadedQueueCounts = LoadedQueueCounts
   { loadedQueueCount :: Int,
-    loadedNotifierCount :: Int,
-    openJournalCount :: Int,
-    queueLockCount :: Int,
-    notifierLockCount :: Int
+    loadedNotifierCount :: Int
   }
 
 newMessageStats :: MessageStats
 newMessageStats = MessageStats 0 0 0
 
 addQueue :: MsgStoreClass s => s -> RecipientId -> QueueRec -> IO (Either ErrorType (StoreQueue s))
-addQueue st = addQueue_ (queueStore st) (mkQueue st True)
+addQueue st = addQueue_ (queueStore st) (mkQueue st)
 {-# INLINE addQueue #-}
 
 getQueue :: (MsgStoreClass s, QueueParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
@@ -184,28 +118,3 @@ getQueueRecs st party qIds = getQueues st party qIds >>= mapM (fmap join . mapM
 readQueueRec :: StoreQueueClass q => q -> IO (Either ErrorType (q, QueueRec))
 readQueueRec q = maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec q)
 {-# INLINE readQueueRec #-}
-
--- The action is called with Nothing when it is known that the queue is empty
-withPeekMsgQueue :: MsgStoreClass s => s -> StoreQueue s -> Text -> (Maybe (MsgQueue s, Message) -> StoreMonad s a) -> ExceptT ErrorType IO a
-withPeekMsgQueue st q op a = isolateQueue st q op $ getPeekMsgQueue st q >>= a
-{-# INLINE withPeekMsgQueue #-}
-
--- not used with PostgreSQL message store
-expireQueueMsgs :: MsgStoreClass s => s -> Int64 -> Int64 -> StoreQueue s -> StoreMonad s MessageStats
-expireQueueMsgs st now old q = do
-  (expired_, stored) <- withIdleMsgQueue now st q $ deleteExpireMsgs_ old q
-  pure MessageStats {storedMsgsCount = stored, expiredMsgsCount = fromMaybe 0 expired_, storedQueues = 1}
-
--- not used with PostgreSQL message store
-deleteExpireMsgs_ :: MsgStoreClass s => Int64 -> StoreQueue s -> MsgQueue s -> StoreMonad s Int
-deleteExpireMsgs_ old q mq = do
-  n <- loop 0
-  logQueueState q
-  pure n
-  where
-    loop dc =
-      tryPeekMsg_ q mq >>= \case
-        Just Message {msgTs}
-          | systemSeconds msgTs < old ->
-              tryDeleteMsg_ q mq False >> loop (dc + 1)
-        _ -> pure dc

src/Simplex/Messaging/Server/Prometheus.hs

@@ -46,7 +46,7 @@ data RealTimeMetrics = RealTimeMetrics
     deliveredTimes :: TimeBuckets,
     smpSubs :: RTSubscriberMetrics,
     ntfSubs :: RTSubscriberMetrics,
-    loadedCounts :: LoadedQueueCounts
+    loadedCounts :: Maybe LoadedQueueCounts
   }
 
 data RTSubscriberMetrics = RTSubscriberMetrics
@@ -562,27 +562,17 @@ prometheusMetrics sm rtm ts =
       \\n\
       \# HELP simplex_smp_subscription_ntf_service_subs_total Total queues subscribed via NTF services\n\
       \# TYPE simplex_smp_subscription_ntf_service_subs_total gauge\n\
-      \simplex_smp_subscription_ntf_service_subs_total " <> mshow (subServiceSubsCount ntfSubs) <> "\n# ntf.subServiceSubsCount\n\
-      \\n\
-      \# HELP simplex_smp_loaded_queues_queue_count Total loaded queues count (all queues for memory/journal storage)\n\
+      \simplex_smp_subscription_ntf_service_subs_total " <> mshow (subServiceSubsCount ntfSubs) <> "\n# ntf.subServiceSubsCount\n"
+      <> maybe "" loadedQueues loadedCounts
+    loadedQueues LoadedQueueCounts {loadedQueueCount, loadedNotifierCount} =
+      "\n\
+      \# HELP simplex_smp_loaded_queues_queue_count Total loaded queues count (all queues for memory storage)\n\
       \# TYPE simplex_smp_loaded_queues_queue_count gauge\n\
-      \simplex_smp_loaded_queues_queue_count " <> mshow (loadedQueueCount loadedCounts) <> "\n# loadedCounts.loadedQueueCount\n\
+      \simplex_smp_loaded_queues_queue_count " <> mshow loadedQueueCount <> "\n# loadedCounts.loadedQueueCount\n\
       \\n\
-      \# HELP simplex_smp_loaded_queues_ntf_count Total loaded ntf credential references (all ntf credentials for memory/journal storage)\n\
+      \# HELP simplex_smp_loaded_queues_ntf_count Total loaded ntf credential references (all ntf credentials for memory storage)\n\
       \# TYPE simplex_smp_loaded_queues_ntf_count gauge\n\
-      \simplex_smp_loaded_queues_ntf_count " <> mshow (loadedNotifierCount loadedCounts) <> "\n# loadedCounts.loadedNotifierCount\n\
-      \\n\
-      \# HELP simplex_smp_loaded_queues_open_journal_count Total opened queue journals (0 for memory storage)\n\
-      \# TYPE simplex_smp_loaded_queues_open_journal_count gauge\n\
-      \simplex_smp_loaded_queues_open_journal_count " <> mshow (openJournalCount loadedCounts) <> "\n# loadedCounts.openJournalCount\n\
-      \\n\
-      \# HELP simplex_smp_loaded_queues_queue_lock_count Total queue locks (0 for memory storage)\n\
-      \# TYPE simplex_smp_loaded_queues_queue_lock_count gauge\n\
-      \simplex_smp_loaded_queues_queue_lock_count " <> mshow (queueLockCount loadedCounts) <> "\n# loadedCounts.queueLockCount\n\
-      \\n\
-      \# HELP simplex_smp_loaded_queues_ntf_lock_count Total notifier locks (0 for memory/journal storage)\n\
-      \# TYPE simplex_smp_loaded_queues_ntf_lock_count gauge\n\
-      \simplex_smp_loaded_queues_ntf_lock_count " <> mshow (notifierLockCount loadedCounts) <> "\n# loadedCounts.notifierLockCount\n"
+      \simplex_smp_loaded_queues_ntf_count " <> mshow loadedNotifierCount <> "\n# loadedCounts.loadedNotifierCount\n"
 
     showTimeBuckets :: Text -> IM.IntMap Int -> Text
     showTimeBuckets metric = T.concat . snd . mapAccumL accumBucket (0, 0) . IM.assocs

src/Simplex/Messaging/Server/QueueStore/Postgres.hs

@@ -24,9 +24,7 @@ module Simplex.Messaging.Server.QueueStore.Postgres
     batchInsertServices,
     batchInsertQueues,
     foldServiceRecs,
-    foldRcvServiceQueueRecs,
     foldQueueRecs,
-    foldRecentQueueRecs,
     handleDuplicate,
     rowToQueueRec,
     withLog_,
@@ -43,13 +41,12 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
-import Data.Bifunctor (first)
 import Data.ByteString.Builder (Builder)
 import qualified Data.ByteString.Builder as BB
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.Bitraversable (bimapM)
-import Data.Either (fromRight, lefts)
+import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (foldl', intersperse, partition)
@@ -91,7 +88,7 @@ import Simplex.Messaging.SystemTime
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPServiceRole (..))
-import Simplex.Messaging.Util (eitherToMaybe, firstRow, ifM, maybeFirstRow, maybeFirstRow', tshow, (<$$>), ($>>=))
+import Simplex.Messaging.Util (eitherToMaybe, firstRow, maybeFirstRow, maybeFirstRow', tshow, (<$$>), ($>>=))
 import System.Exit (exitFailure)
 import System.IO (IOMode (..), hFlush, stdout)
 import UnliftIO.STM
@@ -103,33 +100,19 @@ import Simplex.Messaging.Encoding.String
 data PostgresQueueStore q = PostgresQueueStore
   { dbStore :: DBStore,
     dbStoreLog :: Maybe (StoreLog 'WriteMode),
-    -- this map caches all created and opened queues
-    queues :: TMap RecipientId q,
-    -- this map only cashes the queues that were attempted to send messages to,
-    senders :: TMap SenderId RecipientId,
-    -- this map only cashes the queues that were attempted to be subscribed to,
-    notifiers :: TMap NotifierId RecipientId,
-    notifierLocks :: TMap NotifierId Lock,
     serviceLocks :: TMap CertFingerprint Lock,
-    deletedTTL :: Int64,
-    useCache :: Bool
+    deletedTTL :: Int64
   }
 
-type UseQueueCache = Bool
-
 instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
-  type QueueStoreCfg (PostgresQueueStore q) = (PostgresStoreCfg, UseQueueCache)
+  type QueueStoreCfg (PostgresQueueStore q) = PostgresStoreCfg
 
-  newQueueStore :: (PostgresStoreCfg, UseQueueCache)  -> IO (PostgresQueueStore q)
-  newQueueStore (PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL}, useCache) = do
+  newQueueStore :: PostgresStoreCfg -> IO (PostgresQueueStore q)
+  newQueueStore PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL} = do
     dbStore <- either err pure =<< createDBStore dbOpts serverMigrations (MigrationConfig confirmMigrations Nothing)
     dbStoreLog <- mapM (openWriteStoreLog True) dbStoreLogPath
-    queues <- TM.emptyIO
-    senders <- TM.emptyIO
-    notifiers <- TM.emptyIO
-    notifierLocks <- TM.emptyIO
     serviceLocks <- TM.emptyIO
-    pure PostgresQueueStore {dbStore, dbStoreLog, queues, senders, notifiers, notifierLocks, serviceLocks, deletedTTL, useCache}
+    pure PostgresQueueStore {dbStore, dbStoreLog, serviceLocks, deletedTTL}
     where
       err e = do
         logError $ "STORE: newQueueStore, error opening PostgreSQL database, " <> tshow e
@@ -140,9 +123,6 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
     closeDBStore dbStore
     mapM_ closeStoreLog dbStoreLog
 
-  loadedQueues = queues
-  {-# INLINE loadedQueues #-}
-
   compactQueues :: PostgresQueueStore q -> IO Int64
   compactQueues st@PostgresQueueStore {deletedTTL} = do
     old <- subtract deletedTTL . systemSeconds <$> liftIO getSystemTime
@@ -168,160 +148,45 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
           (SRMessaging, SRNotifier)
       pure EntityCounts {queueCount, notifierCount, rcvServiceCount, ntfServiceCount, rcvServiceQueuesCount, ntfServiceQueuesCount}
 
-  -- this implementation assumes that the lock is already taken by addQueue
-  -- and relies on unique constraints in the database to prevent duplicate IDs.
+  -- this implementation relies on unique constraints in the database to prevent duplicate IDs.
   addQueue_ :: PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
   addQueue_ st mkQ rId qr = do
-    sq <- mkQ rId qr {queueData = withoutLinkData . fst <$> queueData qr}
-    withQueueLock sq "addQueue_" $ E.uninterruptibleMask_ $ runExceptT $ do
+    sq <- mkQ rId qr
+    E.uninterruptibleMask_ $ runExceptT $ do
       void $ withDB "addQueue_" st $ \db ->
         E.try (DB.execute db insertQueueQuery $ queueRecToRow (rId, qr))
-          >>= bimapM (\e -> unless (isRecipientIdViolation e) (removeQueueLock sq) >> handleDuplicate e) pure
-      when useCache $ do
-        atomically $ TM.insert rId sq queues
-        atomically $ TM.insert (senderId qr) rId senders
-        forM_ (notifier qr) $ \NtfCreds {notifierId = nId} -> atomically $ TM.insert nId rId notifiers
+          >>= bimapM handleDuplicate pure
       withLog "addStoreQueue" st $ \s -> logCreateQueue s rId qr
       pure sq
-    where
-      PostgresQueueStore {queues, senders, notifiers, useCache} = st
-      -- the lock is kept when another queue has the same recipient ID
-      isRecipientIdViolation e = constraintViolation e == Just (UniqueViolation "msg_queues_pkey")
-      -- Not doing duplicate checks in maps as the probability of duplicates is very low.
-      -- It needs to be reconsidered when IDs are supplied by the users.
-      -- hasId = anyM [TM.memberIO rId queues, TM.memberIO senderId senders, hasNotifier]
-      -- hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.memberIO notifierId notifiers) notifier
 
-  getQueue_ :: QueueParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
-  getQueue_ st mkQ party qId
-    | useCache = case party of
-        SRecipient -> getRcvQueue qId
-        SSender -> TM.lookupIO qId senders >>= maybe (mask loadSndQueue) getRcvQueue
-        SSenderLink -> mask loadLinkQueue
-        -- loaded queue is deleted from notifiers map to reduce cache size after queue was subscribed to by ntf server
-        SNotifier -> TM.lookupIO qId notifiers >>= maybe (mask loadNtfQueue) (getRcvQueue >=> (atomically (TM.delete qId notifiers) $>))
-    | otherwise = case party of
-        SRecipient -> loadQueueNoCache " WHERE recipient_id = ?"
-        SSender -> loadQueueNoCache " WHERE sender_id = ?"
-        SSenderLink -> loadQueueNoCache " WHERE link_id = ?"
-        SNotifier -> loadQueueNoCache " WHERE notifier_id = ?"
+  getQueue_ :: QueueParty p => PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ st mkQ party qId = case party of
+    SRecipient -> loadQueue " WHERE recipient_id = ?"
+    SSender -> loadQueue " WHERE sender_id = ?"
+    SSenderLink -> loadQueue " WHERE link_id = ?"
+    SNotifier -> loadQueue " WHERE notifier_id = ?"
     where
-      PostgresQueueStore {queues, senders, notifiers, useCache} = st
-      getRcvQueue rId = TM.lookupIO rId queues >>= maybe (mask loadRcvQueue) (pure . Right)
-      loadRcvQueue = do
-        (rId, qRec) <- loadQueue " WHERE recipient_id = ?"
-        cacheQueue rId qRec $ \_ -> pure () -- recipient map already checked, not caching sender ref
-      loadSndQueue = loadSndQueue_ " WHERE sender_id = ?" cacheSender
-      -- link IDs are supplied by clients, they are not cached to prevent collisions with sender IDs
-      loadLinkQueue = loadSndQueue_ " WHERE link_id = ?" $ \_ -> pure ()
-      loadNtfQueue = do
-        (rId, qRec) <- loadQueue " WHERE notifier_id = ?"
-        liftIO $
-          TM.lookupIO rId queues -- checking recipient map first, not creating lock in map, not caching queue
-            >>= maybe (mkQ False rId qRec) pure
-      loadSndQueue_ condition insertRef = do
-        (rId, qRec) <- loadQueue condition
-        -- checking recipient map first, ref is only cached for the queue in the map
-        atomically (TM.lookup rId queues >>= mapM (\sq -> sq <$ insertRef rId))
-          >>= maybe (cacheQueue rId qRec insertRef) pure
-      loadQueueNoCache cond = mask $ loadQueue cond >>= liftIO . uncurry (mkQ True)
-      mask = E.uninterruptibleMask_ . runExceptT
-      cacheSender rId = TM.insert qId rId senders
-      loadQueue condition = loadQueueBy condition qId
-      loadQueueBy condition qId' =
-        withDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
-          DB.query db (queueRecQuery <> condition <> " AND deleted_at IS NULL") (Only qId')
-      cacheQueue rId qRec insertRef = do
-        sq <- liftIO $ mkQ True rId qRec -- loaded queue
-        -- This lock prevents the scenario when the queue is added to cache,
-        -- while another thread is proccessing the same queue in withAllMsgQueues
-        -- without adding it to cache, possibly trying to open the same files twice.
-        -- Alse see comment in idleDeleteExpiredMsgs.
-        ExceptT $ withQueueLock sq "getQueue_" $ runExceptT $ do
-          -- the queue could have been deleted after it was loaded and before the lock was taken
-          (_, qRec') <- loadQueueBy " WHERE recipient_id = ?" rId `catchE` \case
-            AUTH -> liftIO (removeQueueLock sq) >> throwE AUTH
-            e -> throwE e
-          atomically $
-            -- checking the cache again for concurrent reads,
-            -- use previously loaded queue if exists.
-            TM.lookup rId queues >>= \case
-              Just sq' -> pure sq'
-              Nothing -> do
-                writeTVar (queueRec sq) $ Just qRec'
-                insertRef rId
-                TM.insert rId sq queues
-                pure sq
+      loadQueue condition = E.uninterruptibleMask_ $ runExceptT $ do
+        (rId, qRec) <- withDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
+          DB.query db (queueRecQuery <> condition <> " AND deleted_at IS NULL") (Only qId)
+        liftIO $ mkQ rId qRec
 
-  getQueues_ :: forall p. BatchParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueues_ :: forall p. BatchParty p => PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
   getQueues_ st mkQ party qIds
     | null qIds = pure []
-    | useCache = case party of
-        SRecipient -> do
-          qs <- readTVarIO queues
-          let qs' = map (\qId -> get qs qId qId) qIds
-          E.uninterruptibleMask_ $ loadQueues qs' " WHERE recipient_id IN ?" cacheRcvQueue >>= uncacheDeleted (lefts qs')
-        SNotifier -> do
-          ns <- readTVarIO notifiers
-          qs <- readTVarIO queues
-          let qs' = map (\qId -> get ns qId qId >>= get qs qId) qIds
-          E.uninterruptibleMask_ $ loadQueues qs' " WHERE notifier_id IN ?" $ \(rId, qRec) ->
-            forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> -- it is always Just with this query
-              (nId,) <$> maybe (mkQ False rId qRec) pure (M.lookup rId qs)
     | otherwise = E.uninterruptibleMask_ $ case party of
-        SRecipient -> loadQueuesNoCache " WHERE recipient_id IN ?" $ \(rId, qRec) ->
-          Just . (rId,) <$> mkQ False rId qRec
-        SNotifier -> loadQueuesNoCache " WHERE notifier_id IN ?" $ \(rId, qRec) ->
-          forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> (nId,) <$> mkQ False rId qRec
+        SRecipient -> loadQueues " WHERE recipient_id IN ?" $ \(rId, qRec) ->
+          Just . (rId,) <$> mkQ rId qRec
+        SNotifier -> loadQueues " WHERE notifier_id IN ?" $ \(rId, qRec) ->
+          forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> (nId,) <$> mkQ rId qRec
     where
-      PostgresQueueStore {queues, notifiers, useCache} = st
-      get :: M.Map QueueId a -> QueueId -> QueueId -> Either QueueId a
-      get m qId = maybe (Left qId) Right . (`M.lookup` m)
-      loadQueues :: [Either QueueId q] -> Query -> ((RecipientId, QueueRec) -> IO (Maybe (QueueId, q))) -> IO [Either ErrorType q]
-      loadQueues qs' cond mkCacheQueue = do
-        let qIds' = lefts qs'
-        if null qIds'
-          then pure $ map (first (const INTERNAL)) qs'
-          else do
-            qs_ <- dbLoadQueues qIds' cond mkCacheQueue
-            pure $ map (result qs_) qs'
-        where
-          result :: Either ErrorType (M.Map QueueId q) -> Either QueueId q -> Either ErrorType q
-          result _ (Right q) = Right q
-          result qs_ (Left qId) = maybe (Left AUTH) Right . M.lookup qId =<< qs_
-      dbLoadQueues qIds' cond mkQueue' =
-        runExceptT $ fmap M.fromList $
-          withDB' "getQueues_" st (\db -> DB.query db (queueRecQuery <> cond <> " AND deleted_at IS NULL") (Only (In qIds')))
-            >>= liftIO . fmap catMaybes . mapM (mkQueue' . rowToQueueRec)
-      cacheRcvQueue (rId, qRec) = do
-        sq <- mkQ True rId qRec
-        sq' <- withQueueLock sq "getQueue_" $ atomically $
-          -- checking the cache again for concurrent reads, use previously loaded queue if exists.
-          TM.lookup rId queues >>= \case
-            Just sq' -> pure sq'
-            Nothing -> sq <$ TM.insert rId sq queues
-        pure $ Just (rId, sq')
-      -- the queues could have been deleted after they were loaded and before they were cached
-      uncacheDeleted :: [RecipientId] -> [Either ErrorType q] -> IO [Either ErrorType q]
-      uncacheDeleted qIds' rs = case filter (`S.member` S.fromList qIds') [recipientId sq | Right sq <- rs] of
-        [] -> pure rs
-        rIds ->
-          runExceptT (withDB' "getQueues_" st $ \db -> DB.query db "SELECT recipient_id FROM msg_queues WHERE recipient_id IN ? AND deleted_at IS NULL" (Only (In rIds))) >>= \case
-            Right live -> mapM (uncache $ S.fromList rIds `S.difference` S.fromList (map fromOnly live)) rs
-            Left _ -> pure rs
-      uncache deleted = \case
-        Right sq | S.member (recipientId sq) deleted -> do
-          withQueueLock sq "getQueues_" $ do
-            atomically $ writeTVar (queueRec sq) Nothing >> TM.delete (recipientId sq) queues
-            removeQueueLock sq
-          pure $ Left AUTH
-        r -> pure r
-      loadQueuesNoCache cond mkQueue' = do
-        qs_ <- dbLoadQueues qIds cond mkQueue'
-        pure $ map (result qs_) qIds
-        where
-          result :: Either ErrorType (M.Map QueueId q) -> QueueId -> Either ErrorType q
-          result qs_ qId = maybe (Left AUTH) Right . M.lookup qId =<< qs_
+      loadQueues :: Query -> ((RecipientId, QueueRec) -> IO (Maybe (QueueId, q))) -> IO [Either ErrorType q]
+      loadQueues cond mkQueue' = do
+        qs_ <-
+          runExceptT $ fmap M.fromList $
+            withDB' "getQueues_" st (\db -> DB.query db (queueRecQuery <> cond <> " AND deleted_at IS NULL") (Only (In qIds)))
+              >>= liftIO . fmap catMaybes . mapM (mkQueue' . rowToQueueRec)
+        pure $ map (\qId -> maybe (Left AUTH) Right . M.lookup qId =<< qs_) qIds
 
   getQueueLinkData :: PostgresQueueStore q -> q -> LinkId -> IO (Either ErrorType QueueLinkData)
   getQueueLinkData st sq lnkId = runExceptT $ do
@@ -334,7 +199,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   addQueueLinkData :: PostgresQueueStore q -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
   addQueueLinkData st sq lnkId d =
-    withQueueRec sq "addQueueLinkData" $ \q -> case queueData q of
+    withQueueRec sq $ \q -> case queueData q of
       Nothing ->
         addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId))
       Just (lnkId', _) | lnkId' == lnkId ->
@@ -344,13 +209,13 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
       rId = recipientId sq
       addLink q update = do
         assertUpdated $ withDB' "addQueueLinkData" st update
-        atomically $ writeTVar (queueRec sq) $ Just q {queueData = Just $ withoutLinkData lnkId}
+        atomically $ writeTVar (queueRec sq) $ Just q {queueData = Just (lnkId, d)}
         withLog "addQueueLinkData" st $ \s -> logCreateLink s rId lnkId d
       qry = "UPDATE msg_queues SET fixed_data = ?, user_data = ?, link_id = ? WHERE recipient_id = ? AND deleted_at IS NULL"
 
   deleteQueueLinkData :: PostgresQueueStore q -> q -> IO (Either ErrorType ())
   deleteQueueLinkData st sq =
-    withQueueRec sq "deleteQueueLinkData" $ \q -> case queueData q of
+    withQueueRec sq $ \q -> case queueData q of
       Just _ -> do
         assertUpdated $ withDB' "deleteQueueLinkData" st $ \db ->
           DB.execute db "UPDATE msg_queues SET link_id = NULL, fixed_data = NULL, user_data = NULL WHERE recipient_id = ? AND deleted_at IS NULL" (Only rId)
@@ -362,7 +227,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   secureQueue :: PostgresQueueStore q -> q -> SndPublicAuthKey -> IO (Either ErrorType ())
   secureQueue st sq sKey =
-    withQueueRec sq "secureQueue" $ \q -> do
+    withQueueRec sq $ \q -> do
       verify q
       assertUpdated $ withDB' "secureQueue" st $ \db ->
         DB.execute db "UPDATE msg_queues SET sender_key = ? WHERE recipient_id = ? AND deleted_at IS NULL AND (sender_key IS NULL OR sender_key = ?)" (sKey, rId, sKey)
@@ -376,7 +241,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   updateKeys :: PostgresQueueStore q -> q -> NonEmpty RcvPublicAuthKey -> IO (Either ErrorType ())
   updateKeys st sq rKeys =
-    withQueueRec sq "updateKeys" $ \q -> do
+    withQueueRec sq $ \q -> do
       assertUpdated $ withDB' "updateKeys" st $ \db ->
         DB.execute db "UPDATE msg_queues SET recipient_keys = ? WHERE recipient_id = ? AND deleted_at IS NULL" (rKeys, rId)
       atomically $ writeTVar (queueRec sq) $ Just q {recipientKeys = rKeys}
@@ -386,24 +251,14 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   addQueueNotifier :: PostgresQueueStore q -> q -> NtfCreds -> IO (Either ErrorType (Maybe NtfCreds))
   addQueueNotifier st sq ntfCreds@NtfCreds {notifierId = nId, notifierKey, rcvNtfDhSecret} =
-    withQueueRec sq "addQueueNotifier" $ \q ->
-      checkCachedNotifier $ do
-        assertUpdated $ withDB "addQueueNotifier" st $ \db ->
-          E.try (update db) >>= bimapM handleDuplicate pure
-        nc_ <- forM (notifier q) $ \nc@NtfCreds {notifierId} -> atomically (TM.delete notifierId notifiers) $> nc
-        let !q' = q {notifier = Just ntfCreds}
-        atomically $ writeTVar (queueRec sq) $ Just q'
-        when useCache $ do
-          atomically $ TM.insert nId rId notifiers
-        withLog "addQueueNotifier" st $ \s -> logAddNotifier s rId ntfCreds
-        pure nc_
+    withQueueRec sq $ \q -> do
+      assertUpdated $ withDB "addQueueNotifier" st $ \db ->
+        E.try (update db) >>= bimapM handleDuplicate pure
+      let !q' = q {notifier = Just ntfCreds}
+      atomically $ writeTVar (queueRec sq) $ Just q'
+      withLog "addQueueNotifier" st $ \s -> logAddNotifier s rId ntfCreds
+      pure $ notifier q
     where
-      checkCachedNotifier add
-        | useCache =
-            ExceptT $ withLockMap (notifierLocks st) nId "addQueueNotifier" $
-              ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $ runExceptT add
-        | otherwise = add
-      PostgresQueueStore {notifiers, useCache} = st
       rId = recipientId sq
       update db =
         DB.execute
@@ -417,18 +272,13 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   deleteQueueNotifier :: PostgresQueueStore q -> q -> IO (Either ErrorType (Maybe NtfCreds))
   deleteQueueNotifier st sq =
-    withQueueRec sq "deleteQueueNotifier" $ \q ->
-      ExceptT $ fmap sequence $ forM (notifier q) $ \nc@NtfCreds {notifierId = nId} ->
-        withNotifierLock nId $ runExceptT $ do
-          assertUpdated $ withDB' "deleteQueueNotifier" st update
-          when (useCache st) $ atomically $ TM.delete nId $ notifiers st
-          atomically $ writeTVar (queueRec sq) $ Just q {notifier = Nothing}
-          withLog "deleteQueueNotifier" st (`logDeleteNotifier` rId)
-          pure nc
+    withQueueRec sq $ \q ->
+      forM (notifier q) $ \nc -> do
+        assertUpdated $ withDB' "deleteQueueNotifier" st update
+        atomically $ writeTVar (queueRec sq) $ Just q {notifier = Nothing}
+        withLog "deleteQueueNotifier" st (`logDeleteNotifier` rId)
+        pure nc
     where
-      withNotifierLock nId
-        | useCache st = withLockMap (notifierLocks st) nId "deleteQueueNotifier"
-        | otherwise = id
       rId = recipientId sq
       update db =
         DB.execute
@@ -457,7 +307,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   updateQueueTime :: PostgresQueueStore q -> q -> SystemDate -> IO (Either ErrorType QueueRec)
   updateQueueTime st sq t =
-    withQueueRec sq "updateQueueTime" $ \q@QueueRec {updatedAt} ->
+    withQueueRec sq $ \q@QueueRec {updatedAt} ->
       if updatedAt == Just t
         then pure q
         else do
@@ -470,7 +320,6 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
     where
       rId = recipientId sq
 
-  -- this method is called from JournalMsgStore deleteQueue that already locks the queue
   deleteStoreQueue :: PostgresQueueStore q -> q -> IO (Either ErrorType QueueRec)
   deleteStoreQueue st sq = E.uninterruptibleMask_ $ runExceptT $ do
     q <- ExceptT $ readQueueRecIO qr
@@ -478,13 +327,6 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
     assertUpdated $ withDB' "deleteStoreQueue" st $ \db ->
       DB.execute db "UPDATE msg_queues SET deleted_at = ? WHERE recipient_id = ? AND deleted_at IS NULL" (ts, rId)
     atomically $ writeTVar qr Nothing
-    when (useCache st) $ do
-      atomically $ do
-        TM.delete rId $ queues st
-        TM.delete (senderId q) $ senders st
-      forM_ (notifier q) $ \NtfCreds {notifierId} -> do
-        atomically $ TM.delete notifierId $ notifiers st
-        atomically $ TM.delete notifierId $ notifierLocks st
     withLog "deleteStoreQueue" st (`logDeleteQueue` rId)
     pure q
     where
@@ -507,7 +349,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
       pure serviceId
 
   setQueueService :: (PartyI p, ServiceParty p) => PostgresQueueStore q -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
-  setQueueService st sq party serviceId = withQueueRec sq "setQueueService" $ \q -> case party of
+  setQueueService st sq party serviceId = withQueueRec sq $ \q -> case party of
     SRecipientService
       | rcvServiceId q == serviceId -> pure ()
       | otherwise -> do
@@ -632,33 +474,8 @@ foldServiceRecs st f =
     DB.fold_ db "SELECT service_id, service_role, service_cert, service_cert_hash, created_at FROM services" mempty $
       \ !acc -> fmap (acc <>) . f . rowToServiceRec
 
-foldRcvServiceQueueRecs :: PostgresQueueStore q -> ServiceId -> (a -> (RecipientId, QueueRec) -> IO a) -> a -> IO (Either ErrorType a)
-foldRcvServiceQueueRecs st serviceId f acc =
-  runExceptT $ withDB' "foldRcvServiceQueueRecs" st $ \db ->
-    DB.fold db (queueRecQuery <> " WHERE rcv_service_id = ? AND deleted_at IS NULL") (Only serviceId) acc $ \a -> f a . rowToQueueRec
-
 foldQueueRecs :: Monoid a => Bool -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
-foldQueueRecs withData = foldQueueRecs_ foldRecs
-  where
-    foldRecs db acc f'
-      | withData = DB.fold_ db (queueRecQueryWithData <> cond) acc $ \acc' -> f' acc' . rowToQueueRecWithData
-      | otherwise = DB.fold_ db (queueRecQuery <> cond) acc $ \acc' -> f' acc' . rowToQueueRec
-    cond = " WHERE deleted_at IS NULL ORDER BY recipient_id ASC"
-
-foldRecentQueueRecs :: Monoid a => Int64 -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
-foldRecentQueueRecs old = foldQueueRecs_ foldRecs
-  where
-    foldRecs db acc f' = DB.fold db (queueRecQuery <> cond) (Only old) acc $ \acc' -> f' acc' . rowToQueueRec
-    cond = " WHERE deleted_at IS NULL AND updated_at > ? ORDER BY recipient_id ASC"
-
-foldQueueRecs_ ::
-  Monoid a =>
-  (DB.Connection -> (Int, a) -> ((Int, a) -> (RecipientId, QueueRec) -> IO (Int, a)) -> IO (Int, a)) ->
-  Bool ->
-  PostgresQueueStore q ->
-  ((RecipientId, QueueRec) -> IO a) ->
-  IO a
-foldQueueRecs_ foldRecs tty st f = do
+foldQueueRecs withData tty st f = do
   (n, r) <- withTransaction (dbStore st) $ \db ->
     foldRecs db (0 :: Int, mempty) $ \(i, acc) qr -> do
       r <- f qr
@@ -669,6 +486,10 @@ foldQueueRecs_ foldRecs tty st f = do
   when tty $ putStrLn $ progress n
   pure r
   where
+    foldRecs db acc f'
+      | withData = DB.fold_ db (queueRecQueryWithData <> cond) acc $ \acc' -> f' acc' . rowToQueueRecWithData
+      | otherwise = DB.fold_ db (queueRecQuery <> cond) acc $ \acc' -> f' acc' . rowToQueueRec
+    cond = " WHERE deleted_at IS NULL ORDER BY recipient_id ASC"
     progress i = "Processed: " <> show i <> " records"
 
 queueRecQuery :: Query
@@ -749,7 +570,7 @@ queueDataColumns = \case
 rowToQueueRec :: QueueRecRow -> (RecipientId, QueueRec)
 rowToQueueRec (rId, recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, notifierId_, notifierKey_, rcvNtfDhSecret_, ntfServiceId, status, updatedAt, linkId_, rcvServiceId) =
   let notifier = mkNotifier (notifierId_, notifierKey_, rcvNtfDhSecret_) ntfServiceId
-      queueData = withoutLinkData <$> linkId_
+      queueData = (,(EncDataBytes "", EncDataBytes "")) <$> linkId_
    in (rId, QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt, rcvServiceId})
 
 rowToQueueRecWithData :: QueueRecRow :. (Maybe EncDataBytes, Maybe EncDataBytes) -> (RecipientId, QueueRec)
@@ -759,10 +580,6 @@ rowToQueueRecWithData ((rId, recipientKeys, rcvDhSecret, senderId, senderKey, qu
       queueData = (,(encData immutableData_, encData userData_)) <$> linkId_
    in (rId, QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt, rcvServiceId})
 
--- link data is read from the database when requested
-withoutLinkData :: LinkId -> (LinkId, QueueLinkData)
-withoutLinkData = (,(EncDataBytes "", EncDataBytes ""))
-
 mkNotifier :: (Maybe NotifierId, Maybe NtfPublicAuthKey, Maybe RcvNtfDhSecret) -> Maybe ServiceId -> Maybe NtfCreds
 mkNotifier (Just notifierId, Just notifierKey, Just rcvNtfDhSecret) ntfServiceId =
   Just NtfCreds {notifierId, notifierKey, rcvNtfDhSecret, ntfServiceId}
@@ -778,15 +595,15 @@ rowToServiceRec (serviceId, serviceRole, serviceCert, Binary fp, serviceCreatedA
 
 setStatusDB :: StoreQueueClass q => Text -> PostgresQueueStore q -> q -> ServerEntityStatus -> ExceptT ErrorType IO () -> IO (Either ErrorType ())
 setStatusDB op st sq status writeLog =
-  withQueueRec sq op $ \q -> do
+  withQueueRec sq $ \q -> do
     assertUpdated $ withDB' op st $ \db ->
       DB.execute db "UPDATE msg_queues SET status = ? WHERE recipient_id = ? AND deleted_at IS NULL" (status, recipientId sq)
     atomically $ writeTVar (queueRec sq) $ Just q {status}
     writeLog
 
-withQueueRec :: StoreQueueClass q => q -> Text -> (QueueRec -> ExceptT ErrorType IO a) -> IO (Either ErrorType a)
-withQueueRec sq op action =
-  withQueueLock sq op $ E.uninterruptibleMask_ $ runExceptT $ ExceptT (readQueueRecIO $ queueRec sq) >>= action
+withQueueRec :: StoreQueueClass q => q -> (QueueRec -> ExceptT ErrorType IO a) -> IO (Either ErrorType a)
+withQueueRec sq action =
+  E.uninterruptibleMask_ $ runExceptT $ ExceptT (readQueueRecIO $ queueRec sq) >>= action
 
 assertUpdated :: ExceptT ErrorType IO Int64 -> ExceptT ErrorType IO ()
 assertUpdated = (>>= \n -> when (n == 0) (throwE AUTH))

src/Simplex/Messaging/Server/QueueStore/STM.hs

@@ -18,6 +18,7 @@ module Simplex.Messaging.Server.QueueStore.STM
   ( STMQueueStore (..),
     STMService (..),
     foldRcvServiceQueues,
+    withLoadedQueues,
     setStoreLog,
     withLog',
     readQueueRecIO,
@@ -47,7 +48,7 @@ import Simplex.Messaging.SystemTime
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPServiceRole (..))
-import Simplex.Messaging.Util (anyM, ifM, tshow, unlessM, ($>>), ($>>=), (<$$), (<$$>))
+import Simplex.Messaging.Util (anyM, ifM, tshow, ($>>), ($>>=), (<$$), (<$$>))
 import System.IO
 import UnliftIO.STM
 
@@ -91,8 +92,6 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
     atomically $ TM.clear senders
     atomically $ TM.clear notifiers
 
-  loadedQueues = queues
-  {-# INLINE loadedQueues #-}
   compactQueues _ = pure 0
   {-# INLINE compactQueues #-}
 
@@ -119,10 +118,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
   addQueue_ :: STMQueueStore q -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
   addQueue_ st mkQ rId qr@QueueRec {senderId = sId, notifier, queueData, rcvServiceId} = do
     sq <- mkQ rId qr
-    add sq >>= \case
-      Right () -> withLog "addStoreQueue" st (\s -> logCreateQueue s rId qr) $> Right sq
-      -- the lock is kept when another queue has the same recipient ID
-      Left e -> Left e <$ unlessM (TM.memberIO rId queues) (removeQueueLock sq)
+    add sq $>> withLog "addStoreQueue" st (\s -> logCreateQueue s rId qr) $> Right sq
     where
       STMQueueStore {queues, senders, notifiers, links} = st
       add q = atomically $ ifM hasId (pure $ Left DUPLICATE_) $ Right () <$ do
@@ -137,7 +133,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
       hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.member notifierId notifiers) notifier
       hasLink = maybe (pure False) (\(lnkId, _) -> TM.member lnkId links) queueData
 
-  getQueue_ :: QueueParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ :: QueueParty p => STMQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
   getQueue_ st _ party qId =
     maybe (Left AUTH) Right <$> case party of
       SRecipient -> TM.lookupIO qId queues
@@ -147,7 +143,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
     where
       STMQueueStore {queues, senders, notifiers, links} = st
 
-  getQueues_ :: BatchParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueues_ :: BatchParty p => STMQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
   getQueues_ st _ party qIds = case party of
     SRecipient -> do
       qs <- readTVarIO queues
@@ -383,6 +379,11 @@ foldRcvServiceQueues st serviceId f acc =
   where
     get rId = TM.lookupIO rId (queues st) $>>= \q -> (q,) <$$> readTVarIO (queueRec q)
 
+withLoadedQueues :: Monoid a => STMQueueStore q -> (q -> IO a) -> IO a
+withLoadedQueues st f = readTVarIO (queues st) >>= foldM run mempty
+  where
+    run !acc = fmap (acc <>) . f
+
 withQueueRec :: TVar (Maybe QueueRec) -> (QueueRec -> STM a) -> IO (Either ErrorType a)
 withQueueRec qr a = atomically $ readQueueRec qr >>= mapM a
 

src/Simplex/Messaging/Server/QueueStore/Types.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -9,37 +8,29 @@ module Simplex.Messaging.Server.QueueStore.Types
   ( StoreQueueClass (..),
     QueueStoreClass (..),
     EntityCounts (..),
-    withLoadedQueues,
   ) where
 
 import Control.Concurrent.STM
-import Control.Monad
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
-import Data.Text (Text)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.SystemTime
-import Simplex.Messaging.TMap (TMap)
 
 class StoreQueueClass q where
   recipientId :: q -> RecipientId
   queueRec :: q -> TVar (Maybe QueueRec)
-  withQueueLock :: q -> Text -> IO a -> IO a
-  -- must only be called for deleted or not added queues
-  removeQueueLock :: q -> IO ()
 
 class StoreQueueClass q => QueueStoreClass q s where
   type QueueStoreCfg s
   newQueueStore :: QueueStoreCfg s -> IO s
   closeQueueStore :: s -> IO ()
   getEntityCounts :: s -> IO EntityCounts
-  loadedQueues :: s -> TMap RecipientId q
   compactQueues :: s -> IO Int64
   addQueue_ :: s -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
-  getQueue_ :: QueueParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
-  getQueues_ :: BatchParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueue_ :: QueueParty p => s -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueues_ :: BatchParty p => s -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
   getQueueLinkData :: s -> q -> LinkId -> IO (Either ErrorType QueueLinkData)
   addQueueLinkData :: s -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
   deleteQueueLinkData :: s -> q -> IO (Either ErrorType ())
@@ -66,8 +57,3 @@ data EntityCounts = EntityCounts
     rcvServiceQueuesCount :: Int,
     ntfServiceQueuesCount :: Int
   }
-
-withLoadedQueues :: (Monoid a, QueueStoreClass q s) => s -> (q -> IO a) -> IO a
-withLoadedQueues st f = readTVarIO (loadedQueues st) >>= foldM run mempty
-  where
-    run !acc = fmap (acc <>) . f

src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs

@@ -20,7 +20,7 @@ import Data.Text.Encoding (decodeLatin1)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ASubscriberParty (..), ErrorType, RecipientId, SParty (..))
 import Simplex.Messaging.Server.QueueStore (QueueRec, ServiceRec (..))
-import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..), STMService (..))
+import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..), STMService (..), withLoadedQueues)
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Util (tshow, ($>>=))
@@ -65,7 +65,7 @@ readQueueStore tty mkQ f st = readLogLines tty f $ \_ -> processLine
         printError :: String -> IO ()
         printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
         withQueue :: forall a. RecipientId -> T.Text -> (q -> IO (Either ErrorType a)) -> IO ()
-        withQueue qId op a = (getQueue_ st (\_ -> mkQ) SRecipient qId $>>= a) >>= qError qId op
+        withQueue qId op a = (getQueue_ st mkQ SRecipient qId $>>= a) >>= qError qId op
         qError qId op = \case
           Left e -> logError $ logPfx qId op <> tshow e
           Right _ -> pure ()