migration

use server IP addresses
2026-08-31 03:08:24 +00:00 · 2022-03-20 14:50:16 +04:00 · 2022-03-20 14:48:09 +04:00
32 changed files with 331 additions and 680 deletions
@@ -1,26 +1,9 @@
-# 1.1.0
-
-SMP server:
-
- message TTL and periodic deletion of old messages
- configuration to prevent creation of the new queues
-
-SMP agent:
-
- asynchronous connection handshake
- configurable SMP servers at run-time
- use TCP keep-alive for connection stability
- improve stability of connection subscriptions
- auto-vacuum DB to remove deleted records
-
 # 1.0.3

 SMP server:
-
 - Reduce server message queue quota to 128 messages.

 SMP agent:
-
 - Add "yes to migrations" option.
 - Make new SMP client attempt to reconnect on network error.
 - Reduce connection handshake expiration to 2 days.
@@ -30,29 +13,24 @@ JSON encoding of types used in simplex-chat, some other minor adjustments.
 # 1.0.2

 General:
-
 - Enable TLS 1.3 parameters for TLS handshake (server and client).
 - Switch from hs-tls fork to original repo now that it supports getFinished and getPeerFinished APIs for both TLS 1.2 and TLS 1.3.

 SMP server:
-
 - Perform TLS handshake in a separate thread per-connection.

 SMP agent:
-
 - Cease attempts to send HELLO after one week timeout.
 - Coalesce requests to connect to SMP servers, to have 1 connection per server.

 # 1.0.1

 SMP server:
-
 - Explicitly set line buffering in stdout/stderr to log each line when output is redirected to files.

 # 1.0.0

 Security and privacy improvements:
-
 - Faster and more secure 2-layer E2E encryption with additional encryption layer between servers and recipients:
  - application messages in each duplex connection (managed by SMP agents - see [overview](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md)) are encrypted using [double-ratchet algorithm](https://www.signal.org/docs/specifications/doubleratchet/), providing forward secrecy and break-in recovery. This layer uses two Curve448 keys per client for [X3DH key agreement](https://www.signal.org/docs/specifications/x3dh/), SHA512 based HKDFs and AES-GCM AEAD encryption.
  - SMP client messages are additionally E2E encrypted in each SMP queue to avoid cipher-text correlation of messages sent via multiple redundant queues (that will be supported soon). This and the next layer use [NaCl crypto_box algorithm](https://nacl.cr.yp.to/index.html) with XSalsa20Poly1305 cipher and Curve25519 keys for DH key agreement.
@@ -65,16 +43,13 @@ Security and privacy improvements:
 - Server identity verification via server offline certificate fingerprints included in SMP server addresses.

 New functionality:
-
 - Support for notification servers with new SMP commands: `NKEY`/`NID`, `NSUB`/`NMSG`.

 Efficiency improvements:
-
 - Binary protocol encodings to reduce overhead from circa 15% to approximately 3.7% of transmitted application message size, with only 2.2% overhead for SMP protocol messages.
 - More performant cryptographic algorithms.

 For more information about SimpleX:
-
 - [SimpleX overview](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md).
 - [SimpleX chat v1 announcement](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20220112-simplex-chat-v1-released.md).

@@ -27,9 +27,9 @@ SimpleXMQ is implemented in Haskell - it benefits from robust software transacti

 ### SMP server

-[SMP server](https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-server/Main.hs) can be run on any Linux distribution, including low power/low memory devices. OpenSSL library is required for initialization.
+[SMP server](https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-server/Main.hs) can be run on any Linux distribution without any dependencies, including low power/low memory devices.

-To initialize the server use `smp-server init -n <fqdn>` (or `smp-server init --ip <ip>` for IP based address) command - it will generate keys and certificates for TLS transport. The fingerprint of offline certificate is used as part of the server address to protect client/server connection against man-in-the-middle attacks: `smp://<fingerprint>@<hostname>[:5223]`.
+To initialize the server use `smp-server init` command - it will generate keys and certificates for TLS transport. The fingerprint of offline certificate is used as part of the server address to protect client/server connection against man-in-the-middle attacks: `smp://<fingerprint>@<hostname>[:5223]`.

 SMP server uses in-memory persistence with an optional append-only log of created queues that allows to re-start the server without losing the connections. This log is compacted on every server restart, permanently removing suspended and removed queues.

@@ -87,26 +87,6 @@ You can either run your own SMP server locally or deploy using [Linode StackScri

 It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI.

-## Deploy SMP server on Linux
-
-You can run your SMP server as a Linux process, optionally using a service manager for booting and restarts.
-
- For Ubuntu you can download a binary from [the latest release](https://github.com/simplex-chat/simplexmq/releases).
-
-  If you're using other Linux distribution and the binary is incompatible with it, you can build from source using [Haskell stack](https://docs.haskellstack.org/en/stable/README/):
-
-  ```shell
-  curl -sSL https://get.haskellstack.org/ | sh
-  ...
-  stack install
-  ```
-
- Initialize SMP server with `smp-server init [-l] -n <fqdn>` or `smp-server init [-l] --ip <ip>` - depending on how you initialize it, either FQDN or IP will be used for server's address.
-
- Run `smp-server start` to start SMP server, or you can configure a service manager to run it as a service.
-
-See [this section](#smp-server) for more information. Run `smp-server -h` and `smp-server init -h` for explanation of commands and options.
-
 [<img alt="Linode" src="https://raw.githubusercontent.com/simplex-chat/simplexmq/master/img/linode.svg" align="right" width="200">](https://cloud.linode.com/stackscripts/748014)

 ## Deploy SMP server on Linode
@@ -3,7 +3,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}

@@ -132,7 +131,8 @@ cliCommandP =
                <*> strOption
                  ( long "ip"
                      <> help
-                        "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
+                        "Server IP address used as Subject Alternative Name for TLS online certificate, \
+                        \also used as Common Name if FQDN is not supplied"
                      <> value "127.0.0.1"
                      <> showDefault
                      <> metavar "IP"
@@ -140,7 +140,7 @@ cliCommandP =
                <*> (optional . strOption)
                  ( long "fqdn"
                      <> short 'n'
-                      <> help "Server FQDN used as Common Name for TLS online certificate"
+                      <> help "Server FQDN used as Common Name and Subject Alternative Name for TLS online certificate"
                      <> showDefault
                      <> metavar "FQDN"
                  )
@@ -284,10 +284,7 @@ runServer IniOptions {enableStoreLog, port, enableWebsockets} = do
          caCertificateFile = caCrtFile,
          privateKeyFile = serverKeyFile,
          certificateFile = serverCrtFile,
-          storeLog,
-          allowNewQueues = True,
-          messageTTL = Just $ 7 * 86400, -- 7 days
-          expireMessagesInterval = Just 21600_000000 -- microseconds, 6 hours
+          storeLog
        }

    openStoreLog :: IO (Maybe (StoreLog 'ReadMode))
@@ -2,5 +2,5 @@ packages: .

 source-repository-package
    type: git
-    location: https://github.com/simplex-chat/aeson.git
+    location: git://github.com/simplex-chat/aeson.git
    tag: 3eb66f9a68f103b5f1489382aad89f5712a64db7
@@ -1,7 +1,7 @@
 name: simplexmq
-version: 1.1.0
+version: 1.0.3
 synopsis: SimpleXMQ message broker
-description: |
+description:  |
  This package includes <./docs/Simplex-Messaging-Server.html server>,
  <./docs/Simplex-Messaging-Client.html client> and
  <./docs/Simplex-Messaging-Agent.html agent> for SMP protocols:
@@ -45,7 +45,7 @@ dependencies:
  - iso8601-time == 0.1.*
  - memory == 0.15.*
  - mtl == 2.2.*
-  - network == 3.1.2.*
+  - network == 3.1.*
  - network-transport == 0.5.*
  - QuickCheck == 2.14.*
  - random >= 1.1 && < 1.3
@@ -64,17 +64,6 @@ dependencies:
  - x509-store == 1.6.*
  - x509-validation == 1.6.*

-flags:
-  swift:
-    description: Enable swift JSON format
-    manual: True
-    default: False
-
-when:
-  - condition: flag(swift)
-    ghc-options:
-      - -DswiftJSON
-
 library:
  source-dirs: src

@@ -1,21 +0,0 @@
-# SMP confirmation timeout recovery
-
-## Problem
-
-When sending an SMP confirmation a network timeout can lead to the following race condition:
- server receives the confirmation while the joining party fails to receive the server's response;
- joining party deletes the connection together with credentials sent in the confirmation for securing the queue;
- initiating party will receive the confirmation from the server and secure the queue;
- on subsequent attempt to join via the same invitation link initiating party will generate new credentials and fail authorization.
-
-This renders the joining party permanently unable to join via that invitation link and complete the connection.
-
-## Solution
-
-A possible solution is to keep and try to reuse same credentials on subsequent attempts:
- joining party has to remember invitation link when saving the connection;
- if SMP confirmation fails due to network timeout joining party doesn't delete the connection and keeps the credentials;
- when joining, joining party checks whether such invitation link was already used for a connection, if yes:
-  - joining party tries to send SMP confirmation with the same credentials;
-  - if this SMP confirmation fails with authorization error (for example it can happen due to race condition explained above) joining party tries to send HELLO message;
-  - if HELLO message fails with authorization error (it can happen if connection was deleted or secured with different credentials), the recovery is no longer possible and connection can be deleted.
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack

 name:           simplexmq
-version:        1.1.0
+version:        1.0.3
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -27,11 +27,6 @@ extra-source-files:
    README.md
    CHANGELOG.md

-flag swift
-  description: Enable swift JSON format
-  manual: True
-  default: False
-
 library
  exposed-modules:
      Simplex.Messaging.Agent
@@ -46,6 +41,7 @@ library
      Simplex.Messaging.Agent.Store.SQLite.Migrations
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220320_server_ips
      Simplex.Messaging.Client
      Simplex.Messaging.Crypto
      Simplex.Messaging.Crypto.Ratchet
@@ -60,10 +56,8 @@ library
      Simplex.Messaging.Server.QueueStore
      Simplex.Messaging.Server.QueueStore.STM
      Simplex.Messaging.Server.StoreLog
-      Simplex.Messaging.TMap
      Simplex.Messaging.Transport
      Simplex.Messaging.Transport.Client
-      Simplex.Messaging.Transport.KeepAlive
      Simplex.Messaging.Transport.Server
      Simplex.Messaging.Transport.WebSockets
      Simplex.Messaging.Util
@@ -98,7 +92,7 @@ library
    , iso8601-time ==0.1.*
    , memory ==0.15.*
    , mtl ==2.2.*
-    , network ==3.1.2.*
+    , network ==3.1.*
    , network-transport ==0.5.*
    , random >=1.1 && <1.3
    , simple-logger ==0.1.*
@@ -115,8 +109,6 @@ library
    , x509 ==1.7.*
    , x509-store ==1.6.*
    , x509-validation ==1.6.*
-  if flag(swift)
-    ghc-options: -DswiftJSON
  default-language: Haskell2010

 executable smp-agent
@@ -151,7 +143,7 @@ executable smp-agent
    , iso8601-time ==0.1.*
    , memory ==0.15.*
    , mtl ==2.2.*
-    , network ==3.1.2.*
+    , network ==3.1.*
    , network-transport ==0.5.*
    , random >=1.1 && <1.3
    , simple-logger ==0.1.*
@@ -169,8 +161,6 @@ executable smp-agent
    , x509 ==1.7.*
    , x509-store ==1.6.*
    , x509-validation ==1.6.*
-  if flag(swift)
-    ghc-options: -DswiftJSON
  default-language: Haskell2010

 executable smp-server
@@ -206,7 +196,7 @@ executable smp-server
    , iso8601-time ==0.1.*
    , memory ==0.15.*
    , mtl ==2.2.*
-    , network ==3.1.2.*
+    , network ==3.1.*
    , network-transport ==0.5.*
    , optparse-applicative >=0.15 && <0.17
    , process ==1.6.*
@@ -226,8 +216,6 @@ executable smp-server
    , x509 ==1.7.*
    , x509-store ==1.6.*
    , x509-validation ==1.6.*
-  if flag(swift)
-    ghc-options: -DswiftJSON
  default-language: Haskell2010

 test-suite smp-server-test
@@ -277,7 +265,7 @@ test-suite smp-server-test
    , iso8601-time ==0.1.*
    , memory ==0.15.*
    , mtl ==2.2.*
-    , network ==3.1.2.*
+    , network ==3.1.*
    , network-transport ==0.5.*
    , random >=1.1 && <1.3
    , simple-logger ==0.1.*
@@ -296,6 +284,4 @@ test-suite smp-server-test
    , x509 ==1.7.*
    , x509-store ==1.6.*
    , x509-validation ==1.6.*
-  if flag(swift)
-    ghc-options: -DswiftJSON
  default-language: Haskell2010
@@ -76,14 +76,13 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
-import Simplex.Messaging.Client (SMPClient (..), SMPServerTransmission)
+import Simplex.Messaging.Client (SMPServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (parse)
 import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
-import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (bshow, liftError, tryError, unlessM)
 import Simplex.Messaging.Version
 import System.Random (randomR)
@@ -252,7 +251,6 @@ joinConn c connId (CRInvitationUri (ConnReqUriData _ agentVRange (qUri :| _)) e2
          void $ enqueueMessage c connId' sq HELLO
          pure connId'
        Left e -> do
-          -- TODO recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md
          withStore (`deleteConn` connId')
          throwError e
    _ -> throwError $ AGENT A_VERSION
@@ -363,13 +361,18 @@ resumeMsgDelivery c connId sq@SndQueue {server, sndId} = do
  let qKey = (connId, server, sndId)
  unlessM (queueDelivering qKey) $
    async (runSmpQueueMsgDelivery c connId sq)
-      >>= \a -> atomically (TM.insert qKey a $ smpQueueMsgDeliveries c)
+      >>= atomically . modifyTVar (smpQueueMsgDeliveries c) . M.insert qKey
  unlessM connQueued $
    withStore (`getPendingMsgs` connId)
      >>= queuePendingMsgs c connId sq
  where
-    queueDelivering qKey = atomically $ isJust <$> TM.lookup qKey (smpQueueMsgDeliveries c)
-    connQueued = atomically $ isJust <$> TM.lookupInsert connId True (connMsgsQueued c)
+    queueDelivering qKey = isJust . M.lookup qKey <$> readTVarIO (smpQueueMsgDeliveries c)
+    connQueued =
+      atomically $
+        isJust
+          <$> stateTVar
+            (connMsgsQueued c)
+            (\m -> (M.lookup connId m, M.insert connId True m))

 queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> [InternalId] -> m ()
 queuePendingMsgs c connId sq msgIds = atomically $ do
@@ -379,11 +382,11 @@ queuePendingMsgs c connId sq msgIds = atomically $ do
 getPendingMsgQ :: AgentClient -> ConnId -> SndQueue -> STM (TQueue InternalId)
 getPendingMsgQ c connId SndQueue {server, sndId} = do
  let qKey = (connId, server, sndId)
-  maybe (newMsgQueue qKey) pure =<< TM.lookup qKey (smpQueueMsgQueues c)
+  maybe (newMsgQueue qKey) pure . M.lookup qKey =<< readTVar (smpQueueMsgQueues c)
  where
    newMsgQueue qKey = do
      mq <- newTQueue
-      TM.insert qKey mq $ smpQueueMsgQueues c
+      modifyTVar (smpQueueMsgQueues c) $ M.insert qKey mq
      pure mq

 runSmpQueueMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
@@ -487,7 +490,7 @@ deleteConnection' c connId =
    delete :: RcvQueue -> m ()
    delete rq = do
      deleteQueue c rq
-      atomically $ removeSubscription c connId
+      removeSubscription c connId
      withStore (`deleteConn` connId)

 -- | Change servers to be used for creating new queues, in Reader monad
@@ -513,7 +516,7 @@ subscriber c@AgentClient {msgQ} = forever $ do
    Right _ -> return ()

 processSMPTransmission :: forall m. AgentMonad m => AgentClient -> SMPServerTransmission -> m ()
-processSMPTransmission c@AgentClient {smpClients, subQ} (srv, sessId, rId, cmd) = do
+processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
  withStore (\st -> getRcvConn st srv rId) >>= \case
    SomeConn SCDuplex (DuplexConnection cData rq _) -> processSMP SCDuplex cData rq
    SomeConn SCRcv (RcvConnection cData rq) -> processSMP SCRcv cData rq
@@ -554,19 +557,10 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, sessId, rId, cmd)
                    _ -> prohibited >> ack
                _ -> prohibited >> ack
            _ -> prohibited >> ack
-        SMP.END ->
-          atomically (TM.lookup srv smpClients >>= fmap join . mapM tryReadTMVar >>= processEND)
-            >>= logServer "<--" c srv rId
-          where
-            processEND = \case
-              Just (Right clnt)
-                | sessId == sessionId clnt -> do
-                  removeSubscription c connId
-                  writeTBQueue subQ ("", connId, END)
-                  pure "END"
-                | otherwise -> ignored
-              _ -> ignored
-            ignored = pure "END from disconnected client - ignored"
+        SMP.END -> do
+          removeSubscription c connId
+          logServer "<--" c srv rId "END"
+          notify END
        _ -> do
          logServer "<--" c srv rId $ "unexpected: " <> bshow cmd
          notify . ERR $ BROKER UNEXPECTED
@@ -51,6 +51,8 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isNothing)
+import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text.Encoding
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
@@ -61,12 +63,10 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol (QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (bshow, liftEitherError, liftError, tryError, whenM)
+import Simplex.Messaging.Util (bshow, liftEitherError, liftError, tryError)
 import Simplex.Messaging.Version
 import System.Timeout (timeout)
-import UnliftIO (async, forConcurrently_)
+import UnliftIO (async)
 import UnliftIO.Exception (Exception, IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -78,13 +78,13 @@ data AgentClient = AgentClient
    subQ :: TBQueue (ATransmission 'Agent),
    msgQ :: TBQueue SMPServerTransmission,
    smpServers :: TVar (NonEmpty SMPServer),
-    smpClients :: TMap SMPServer SMPClientVar,
-    subscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue),
-    pendingSubscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue),
-    subscrConns :: TMap ConnId SMPServer,
-    connMsgsQueued :: TMap ConnId Bool,
-    smpQueueMsgQueues :: TMap (ConnId, SMPServer, SMP.SenderId) (TQueue InternalId),
-    smpQueueMsgDeliveries :: TMap (ConnId, SMPServer, SMP.SenderId) (Async ()),
+    smpClients :: TVar (Map SMPServer SMPClientVar),
+    subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
+    pendingSubscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
+    subscrConns :: TVar (Map ConnId SMPServer),
+    connMsgsQueued :: TVar (Map ConnId Bool),
+    smpQueueMsgQueues :: TVar (Map (ConnId, SMPServer, SMP.SenderId) (TQueue InternalId)),
+    smpQueueMsgDeliveries :: TVar (Map (ConnId, SMPServer, SMP.SenderId) (Async ())),
    reconnections :: TVar [Async ()],
    asyncClients :: TVar [Async ()],
    clientId :: Int,
@@ -100,13 +100,13 @@ newAgentClient agentEnv = do
  subQ <- newTBQueue qSize
  msgQ <- newTBQueue qSize
  smpServers <- newTVar $ initialSMPServers (config agentEnv)
-  smpClients <- TM.empty
-  subscrSrvrs <- TM.empty
-  pendingSubscrSrvrs <- TM.empty
-  subscrConns <- TM.empty
-  connMsgsQueued <- TM.empty
-  smpQueueMsgQueues <- TM.empty
-  smpQueueMsgDeliveries <- TM.empty
+  smpClients <- newTVar M.empty
+  subscrSrvrs <- newTVar M.empty
+  pendingSubscrSrvrs <- newTVar M.empty
+  subscrConns <- newTVar M.empty
+  connMsgsQueued <- newTVar M.empty
+  smpQueueMsgQueues <- newTVar M.empty
+  smpQueueMsgDeliveries <- newTVar M.empty
  reconnections <- newTVar []
  asyncClients <- newTVar []
  clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
@@ -133,12 +133,12 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
  atomically getClientVar >>= either newSMPClient waitForSMPClient
  where
    getClientVar :: STM (Either SMPClientVar SMPClientVar)
-    getClientVar = maybe (Left <$> newClientVar) (pure . Right) =<< TM.lookup srv smpClients
+    getClientVar = maybe (Left <$> newClientVar) (pure . Right) . M.lookup srv =<< readTVar smpClients

    newClientVar :: STM SMPClientVar
    newClientVar = do
      smpVar <- newEmptyTMVar
-      TM.insert srv smpVar smpClients
+      modifyTVar smpClients $ M.insert srv smpVar
      pure smpVar

    waitForSMPClient :: TMVar (Either AgentErrorType SMPClient) -> m SMPClient
@@ -165,12 +165,12 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
                then retryAction
                else atomically $ do
                  putTMVar smpVar (Left e)
-                  TM.delete srv smpClients
+                  modifyTVar smpClients $ M.delete srv
              throwError e
        tryConnectAsync :: m ()
        tryConnectAsync = do
          a <- async connectAsync
-          atomically $ modifyTVar' (asyncClients c) (a :)
+          atomically $ modifyTVar (asyncClients c) (a :)
        connectAsync :: m ()
        connectAsync = do
          ri <- asks $ reconnectInterval . config
@@ -188,24 +188,23 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =

    clientDisconnected :: UnliftIO m -> IO ()
    clientDisconnected u = do
-      removeClientAndSubs >>= (`forM_` serverDown u)
+      removeClientSubs >>= (`forM_` serverDown u)
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv

-    removeClientAndSubs :: IO (Maybe (Map ConnId RcvQueue))
-    removeClientAndSubs = atomically $ do
-      TM.delete srv smpClients
-      cVar_ <- TM.lookupDelete srv $ subscrSrvrs c
-      forM cVar_ $ \cVar -> do
-        cs <- readTVar cVar
-        modifyTVar' (subscrConns c) (`M.withoutKeys` M.keysSet cs)
-        addPendingSubs cVar cs
-        pure cs
+    removeClientSubs :: IO (Maybe (Map ConnId RcvQueue))
+    removeClientSubs = atomically $ do
+      modifyTVar smpClients $ M.delete srv
+      cs <- M.lookup srv <$> readTVar (subscrSrvrs c)
+      modifyTVar (subscrSrvrs c) $ M.delete srv
+      modifyTVar (subscrConns c) $ maybe id (deleteKeys . M.keysSet) cs
+      mapM_ (modifyTVar (pendingSubscrSrvrs c) . addPendingSubs) cs
+      return cs
      where
-        addPendingSubs cVar cs = do
-          let ps = pendingSubscrSrvrs c
-          TM.lookup srv ps >>= \case
-            Just v -> TM.union cs v
-            _ -> TM.insert srv cVar ps
+        addPendingSubs :: Map ConnId RcvQueue -> Map SMPServer (Map ConnId RcvQueue) -> Map SMPServer (Map ConnId RcvQueue)
+        addPendingSubs cs = M.alter (Just . addSubs cs) srv
+        addSubs cs = maybe cs (M.union cs)
+        deleteKeys :: Ord k => Set k -> Map k a -> Map k a
+        deleteKeys ks m = S.foldr' M.delete m ks

    serverDown :: UnliftIO m -> Map ConnId RcvQueue -> IO ()
    serverDown u cs = unless (M.null cs) $ do
@@ -215,7 +214,7 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
    reconnectServer :: m ()
    reconnectServer = do
      a <- async tryReconnectClient
-      atomically $ modifyTVar' (reconnections c) (a :)
+      atomically $ modifyTVar (reconnections c) (a :)

    tryReconnectClient :: m ()
    tryReconnectClient = do
@@ -224,26 +223,19 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
        reconnectClient `catchError` const loop

    reconnectClient :: m ()
-    reconnectClient =
+    reconnectClient = do
      withAgentLock c . withSMP c srv $ \smp -> do
-        cs <- atomically $ mapM readTVar =<< TM.lookup srv (pendingSubscrSrvrs c)
-        forConcurrently_ (maybe [] M.toList cs) $ \sub@(connId, _) ->
-          whenM (atomically $ isNothing <$> TM.lookup connId (subscrConns c)) $
-            subscribe_ smp sub `catchError` handleError connId
-      where
-        subscribe_ :: SMPClient -> (ConnId, RcvQueue) -> ExceptT SMPClientError IO ()
-        subscribe_ smp (connId, rq@RcvQueue {rcvPrivateKey, rcvId}) = do
-          subscribeSMPQueue smp rcvPrivateKey rcvId
-          addSubscription c rq connId
-          liftIO $ notifySub UP connId
-
-        handleError :: ConnId -> SMPClientError -> ExceptT SMPClientError IO ()
-        handleError connId = \case
-          e@SMPResponseTimeout -> throwError e
-          e@SMPNetworkError -> throwError e
-          e -> do
-            liftIO $ notifySub (ERR $ smpClientError e) connId
-            atomically $ removePendingSubscription c srv connId
+        subs <- readTVarIO $ subscrConns c
+        cs <- M.lookup srv <$> readTVarIO (pendingSubscrSrvrs c)
+        forM_ (maybe [] M.toList cs) $ \(connId, rq@RcvQueue {rcvPrivateKey, rcvId}) ->
+          when (isNothing $ M.lookup connId subs) $ do
+            subscribeSMPQueue smp rcvPrivateKey rcvId
+              `catchError` \case
+                e@SMPResponseTimeout -> throwError e
+                e@SMPNetworkError -> throwError e
+                e -> liftIO $ notifySub (ERR $ smpClientError e) connId
+            addSubscription c rq connId
+            liftIO $ notifySub UP connId

    notifySub :: ACommand 'Agent -> ConnId -> IO ()
    notifySub cmd connId = atomically $ writeTBQueue (subQ c) ("", connId, cmd)
@@ -341,7 +333,7 @@ newRcvQueue_ a c srv = do

 subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
 subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
-  atomically $ addPendingSubscription c rq connId
+  addPendingSubscription c rq connId
  withLogSMP c server rcvId "SUB" $ \smp -> do
    liftIO (runExceptT $ subscribeSMPQueue smp rcvPrivateKey rcvId) >>= \case
      Left e -> do
@@ -352,30 +344,34 @@ subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do

 addSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnId -> m ()
 addSubscription c rq@RcvQueue {server} connId = atomically $ do
-  TM.insert connId server $ subscrConns c
+  modifyTVar (subscrConns c) $ M.insert connId server
  addSubs_ (subscrSrvrs c) rq connId
  removePendingSubscription c server connId

-addPendingSubscription :: AgentClient -> RcvQueue -> ConnId -> STM ()
-addPendingSubscription = addSubs_ . pendingSubscrSrvrs
+addPendingSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnId -> m ()
+addPendingSubscription c rq connId =
+  atomically $ addSubs_ (pendingSubscrSrvrs c) rq connId

-addSubs_ :: TMap SMPServer (TMap ConnId RcvQueue) -> RcvQueue -> ConnId -> STM ()
-addSubs_ ss rq@RcvQueue {server} connId =
-  TM.lookup server ss >>= \case
-    Just m -> TM.insert connId rq m
-    _ -> TM.singleton connId rq >>= \m -> TM.insert server m ss
+addSubs_ :: TVar (Map SMPServer (Map ConnId RcvQueue)) -> RcvQueue -> ConnId -> STM ()
+addSubs_ ss rq@RcvQueue {server} connId = modifyTVar ss $ M.alter (Just . addSub) server
+  where
+    addSub = maybe (M.singleton connId rq) (M.insert connId rq)

-removeSubscription :: AgentClient -> ConnId -> STM ()
-removeSubscription c@AgentClient {subscrConns} connId = do
-  server_ <- TM.lookupDelete connId subscrConns
+removeSubscription :: MonadUnliftIO m => AgentClient -> ConnId -> m ()
+removeSubscription c@AgentClient {subscrConns} connId = atomically $ do
+  server_ <- stateTVar subscrConns $ \cs -> (M.lookup connId cs, M.delete connId cs)
  mapM_ (\server -> removeSubs_ (subscrSrvrs c) server connId) server_

 removePendingSubscription :: AgentClient -> SMPServer -> ConnId -> STM ()
-removePendingSubscription = removeSubs_ . pendingSubscrSrvrs
+removePendingSubscription c = removeSubs_ (pendingSubscrSrvrs c)

-removeSubs_ :: TMap SMPServer (TMap ConnId RcvQueue) -> SMPServer -> ConnId -> STM ()
-removeSubs_ ss server connId =
-  TM.lookup server ss >>= mapM_ (TM.delete connId)
+removeSubs_ :: TVar (Map SMPServer (Map ConnId RcvQueue)) -> SMPServer -> ConnId -> STM ()
+removeSubs_ ss server connId = modifyTVar ss $ M.update delSub server
+  where
+    delSub :: Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
+    delSub cs =
+      let cs' = M.delete connId cs
+       in if M.null cs' then Nothing else Just cs'

 logServer :: AgentMonad m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
 logServer dir AgentClient {clientId} srv qId cmdStr =
@@ -127,25 +127,9 @@ connectSQLiteStore dbFilePath poolSize = do
 connectDB :: FilePath -> IO DB.Connection
 connectDB path = do
  dbConn <- DB.open path
-  DB.execute_ dbConn "PRAGMA foreign_keys = ON;"
-  -- DB.execute_ dbConn "PRAGMA trusted_schema = OFF;"
-  DB.execute_ dbConn "PRAGMA secure_delete = ON;"
-  DB.execute_ dbConn "PRAGMA auto_vacuum = FULL;"
-  -- _printPragmas dbConn path
+  DB.execute_ dbConn "PRAGMA foreign_keys = ON; PRAGMA journal_mode = WAL;"
  pure dbConn

-_printPragmas :: DB.Connection -> FilePath -> IO ()
-_printPragmas db path = do
-  foreign_keys <- DB.query_ db "PRAGMA foreign_keys;" :: IO [[Int]]
-  print $ path <> " foreign_keys: " <> show foreign_keys
-  -- when run via sqlite-simple query for trusted_schema seems to return empty list
-  trusted_schema <- DB.query_ db "PRAGMA trusted_schema;" :: IO [[Int]]
-  print $ path <> " trusted_schema: " <> show trusted_schema
-  secure_delete <- DB.query_ db "PRAGMA secure_delete;" :: IO [[Int]]
-  print $ path <> " secure_delete: " <> show secure_delete
-  auto_vacuum <- DB.query_ db "PRAGMA auto_vacuum;" :: IO [[Int]]
-  print $ path <> " auto_vacuum: " <> show auto_vacuum
-
 checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
 checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)

@@ -26,6 +26,7 @@ import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220320_server_ips

 data Migration = Migration {name :: String, up :: Text}
  deriving (Show)
@@ -33,7 +34,8 @@ data Migration = Migration {name :: String, up :: Text}
 schemaMigrations :: [(String, Query)]
 schemaMigrations =
  [ ("20220101_initial", m20220101_initial),
-    ("20220301_snd_queue_keys", m20220301_snd_queue_keys)
+    ("20220301_snd_queue_keys", m20220301_snd_queue_keys),
+    ("20220320_server_ips", m20220320_server_ips)
  ]

 -- | The list of migrations in ascending order by date
@@ -0,0 +1,14 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220320_server_ips where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220320_server_ips :: Query
+m20220320_server_ips =
+  [sql|
+UPDATE servers SET host = '178.79.168.175' WHERE host = 'smp8.simplex.im';
+UPDATE servers SET host = '178.79.169.107' WHERE host = 'smp9.simplex.im';
+UPDATE servers SET host = '45.33.54.229' WHERE host = 'smp10.simplex.im';
+|]
@@ -23,7 +23,7 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Client
  ( -- * Connect (disconnect) client to (from) SMP server
-    SMPClient (sessionId),
+    SMPClient,
    getSMPClient,
    closeSMPClient,

@@ -56,16 +56,15 @@ import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
 import Network.Socket (ServiceName)
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake)
 import Simplex.Messaging.Transport.Client (runTransportClient)
-import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
 import System.Timeout (timeout)
@@ -79,18 +78,18 @@ import System.Timeout (timeout)
 data SMPClient = SMPClient
  { action :: Async (),
    connected :: TVar Bool,
-    sessionId :: SessionId,
+    sessionId :: ByteString,
    smpServer :: SMPServer,
    tcpTimeout :: Int,
    clientCorrId :: TVar Natural,
-    sentCommands :: TMap CorrId Request,
+    sentCommands :: TVar (Map CorrId Request),
    sndQ :: TBQueue SentRawTransmission,
    rcvQ :: TBQueue (SignedTransmission BrokerMsg),
    msgQ :: TBQueue SMPServerTransmission
  }

 -- | Type synonym for transmission from some SPM server queue.
-type SMPServerTransmission = (SMPServer, SessionId, RecipientId, BrokerMsg)
+type SMPServerTransmission = (SMPServer, RecipientId, BrokerMsg)

 -- | SMP client configuration.
 data SMPClientConfig = SMPClientConfig
@@ -100,8 +99,6 @@ data SMPClientConfig = SMPClientConfig
    defaultTransport :: (ServiceName, ATransport),
    -- | timeout of TCP commands (microseconds)
    tcpTimeout :: Int,
-    -- | TCP keep-alive options, Nothing to skip enabling keep-alive
-    tcpKeepAlive :: Maybe KeepAliveOpts,
    -- | period for SMP ping commands (microseconds)
    smpPing :: Int
  }
@@ -112,9 +109,8 @@ smpDefaultConfig =
  SMPClientConfig
    { qSize = 64,
      defaultTransport = ("5223", transport @TLS),
-      tcpTimeout = 5_000_000,
-      tcpKeepAlive = Just defaultKeepAliveOpts,
-      smpPing = 600_000_000 -- 10min
+      tcpTimeout = 4_000_000,
+      smpPing = 30_000_000
    }

 data Request = Request
@@ -130,14 +126,14 @@ type Response = Either SMPClientError BrokerMsg
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO (Either SMPClientError SMPClient)
-getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing} msgQ disconnected =
+getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ disconnected =
  atomically mkSMPClient >>= runClient useTransport
  where
    mkSMPClient :: STM SMPClient
    mkSMPClient = do
      connected <- newTVar False
      clientCorrId <- newTVar 0
-      sentCommands <- TM.empty
+      sentCommands <- newTVar M.empty
      sndQ <- newTBQueue qSize
      rcvQ <- newTBQueue qSize
      return
@@ -159,7 +155,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smp
      thVar <- newEmptyTMVarIO
      action <-
        async $
-          runTransportClient (host smpServer) port' (keyHash smpServer) tcpKeepAlive (client t c thVar)
+          runTransportClient (host smpServer) port' (keyHash smpServer) (client t c thVar)
            `finally` atomically (putTMVar thVar $ Left SMPNetworkError)
      th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar)
      pure $ case th_ of
@@ -197,15 +193,16 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smp
      runExceptT $ sendSMPCommand c Nothing "" PING

    process :: SMPClient -> IO ()
-    process SMPClient {sessionId, rcvQ, sentCommands} = forever $ do
+    process SMPClient {rcvQ, sentCommands} = forever $ do
      (_, _, (corrId, qId, respOrErr)) <- atomically $ readTBQueue rcvQ
      if B.null $ bs corrId
        then sendMsg qId respOrErr
        else do
-          atomically (TM.lookup corrId sentCommands) >>= \case
+          cs <- readTVarIO sentCommands
+          case M.lookup corrId cs of
            Nothing -> sendMsg qId respOrErr
            Just Request {queueId, responseVar} -> atomically $ do
-              TM.delete corrId sentCommands
+              modifyTVar sentCommands $ M.delete corrId
              putTMVar responseVar $
                if queueId == qId
                  then case respOrErr of
@@ -213,12 +210,12 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smp
                    Right (ERR e) -> Left $ SMPServerError e
                    Right r -> Right r
                  else Left SMPUnexpectedResponse
-      where
-        sendMsg :: QueueId -> Either ErrorType BrokerMsg -> IO ()
-        sendMsg qId = \case
-          Right cmd -> atomically $ writeTBQueue msgQ (smpServer, sessionId, qId, cmd)
-          -- TODO send everything else to errQ and log in agent
-          _ -> return ()
+
+    sendMsg :: QueueId -> Either ErrorType BrokerMsg -> IO ()
+    sendMsg qId = \case
+      Right cmd -> atomically $ writeTBQueue msgQ (smpServer, qId, cmd)
+      -- TODO send everything else to errQ and log in agent
+      _ -> return ()

 -- | Disconnects SMP client from the server and terminates client threads.
 closeSMPClient :: SMPClient -> IO ()
@@ -268,11 +265,11 @@ createSMPQueue c rpKey rKey dhKey =
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue
 subscribeSMPQueue :: SMPClient -> RcvPrivateSignKey -> RecipientId -> ExceptT SMPClientError IO ()
-subscribeSMPQueue c@SMPClient {smpServer, sessionId, msgQ} rpKey rId =
+subscribeSMPQueue c@SMPClient {smpServer, msgQ} rpKey rId =
  sendSMPCommand c (Just rpKey) rId SUB >>= \case
    OK -> return ()
    cmd@MSG {} ->
-      lift . atomically $ writeTBQueue msgQ (smpServer, sessionId, rId, cmd)
+      lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
    _ -> throwE SMPUnexpectedResponse

 -- | Subscribe to the SMP queue notifications.
@@ -309,11 +306,11 @@ sendSMPMessage c spKey sId msg =
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
 ackSMPMessage :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
-ackSMPMessage c@SMPClient {smpServer, sessionId, msgQ} rpKey rId =
+ackSMPMessage c@SMPClient {smpServer, msgQ} rpKey rId =
  sendSMPCommand c (Just rpKey) rId ACK >>= \case
    OK -> return ()
    cmd@MSG {} ->
-      lift . atomically $ writeTBQueue msgQ (smpServer, sessionId, rId, cmd)
+      lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
    _ -> throwE SMPUnexpectedResponse

 -- | Irreversibly suspend SMP queue.
@@ -367,6 +364,6 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, sessionId, tcpTimeou
    send :: CorrId -> SentRawTransmission -> STM (TMVar Response)
    send corrId t = do
      r <- newEmptyTMVar
-      TM.insert corrId (Request qId r) sentCommands
+      modifyTVar sentCommands . M.insert corrId $ Request qId r
      writeTBQueue sndQ t
      return r
@@ -98,7 +98,7 @@ enumJSON tagModifier =
    }

 sumTypeJSON :: (String -> String) -> J.Options
-#if defined(darwin_HOST_OS) && defined(swiftJSON)
+#if defined(darwin_HOST_OS)
 sumTypeJSON = singleFieldJSON
 #else
 sumTypeJSON = taggedObjectJSON
@@ -108,7 +108,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
-import Simplex.Messaging.Transport (SessionId, THandle (..), Transport, TransportError (..), tGetBlock, tPutBlock)
+import Simplex.Messaging.Transport (THandle (..), Transport, TransportError (..), tGetBlock, tPutBlock)
 import Simplex.Messaging.Util (bshow, (<$?>))
 import Simplex.Messaging.Version
 import Test.QuickCheck (Arbitrary (..))
@@ -172,14 +172,14 @@ type Signed = ByteString
 data RawTransmission = RawTransmission
  { signature :: ByteString,
    signed :: ByteString,
-    sessId :: SessionId,
+    sessId :: ByteString,
    corrId :: ByteString,
    queueId :: ByteString,
    command :: ByteString
  }

 -- | unparsed sent SMP transmission with signature, without session ID.
-type SignedRawTransmission = (Maybe C.ASignature, SessionId, ByteString, ByteString)
+type SignedRawTransmission = (Maybe C.ASignature, ByteString, ByteString, ByteString)

 -- | unparsed sent SMP transmission with signature.
 type SentRawTransmission = (Maybe C.ASignature, ByteString)
@@ -25,6 +25,7 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking) where

+import Control.Concurrent.STM (stateTVar)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
@@ -33,10 +34,9 @@ import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
-import Data.Int (Int64)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isNothing)
-import Data.Time.Clock.System (SystemTime (..), getSystemTime)
+import Data.Time.Clock.System (getSystemTime)
 import Data.Type.Equality
 import Network.Socket (ServiceName)
 import qualified Simplex.Messaging.Crypto as C
@@ -47,8 +47,6 @@ import Simplex.Messaging.Server.MsgStore.STM (MsgQueue)
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.STM (QueueStore)
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
@@ -70,32 +68,34 @@ runSMPServer cfg = do
 -- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
 -- and when it is disconnected from the TCP socket once the server thread is killed (False).
 runSMPServerBlocking :: (MonadRandom m, MonadUnliftIO m) => TMVar Bool -> ServerConfig -> m ()
-runSMPServerBlocking started cfg = newEnv cfg >>= runReaderT (smpServer started)
-
-smpServer :: forall m. (MonadUnliftIO m, MonadReader Env m) => TMVar Bool -> m ()
-smpServer started = do
-  s <- asks server
-  cfg@ServerConfig {transports} <- asks config
-  raceAny_
-    ( serverThread s subscribedQ subscribers subscriptions cancelSub :
-      serverThread s ntfSubscribedQ notifiers ntfSubscriptions (\_ -> pure ()) :
-      map runServer transports <> expireMessagesThread_ cfg
-    )
-    `finally` withLog closeStoreLog
+runSMPServerBlocking started cfg@ServerConfig {transports} = do
+  env <- newEnv cfg
+  runReaderT smpServer env
  where
-    runServer :: (ServiceName, ATransport) -> m ()
+    smpServer :: (MonadUnliftIO m', MonadReader Env m') => m' ()
+    smpServer = do
+      s <- asks server
+      raceAny_
+        ( serverThread s subscribedQ subscribers subscriptions cancelSub :
+          serverThread s ntfSubscribedQ notifiers ntfSubscriptions (\_ -> pure ()) :
+          map runServer transports
+        )
+        `finally` withLog closeStoreLog
+
+    runServer :: (MonadUnliftIO m', MonadReader Env m') => (ServiceName, ATransport) -> m' ()
    runServer (tcpPort, ATransport t) = do
      serverParams <- asks tlsServerParams
      runTransportServer started tcpPort serverParams (runClient t)

    serverThread ::
-      forall s.
+      forall m' s.
+      MonadUnliftIO m' =>
      Server ->
      (Server -> TBQueue (QueueId, Client)) ->
-      (Server -> TMap QueueId Client) ->
-      (Client -> TMap QueueId s) ->
-      (s -> m ()) ->
-      m ()
+      (Server -> TVar (M.Map QueueId Client)) ->
+      (Client -> TVar (M.Map QueueId s)) ->
+      (s -> m' ()) ->
+      m' ()
    serverThread s subQ subs clientSubs unsub = forever $ do
      atomically updateSubscribers
        >>= fmap join . mapM endPreviousSubscriptions
@@ -110,33 +110,15 @@ smpServer started = do
                  else do
                    yes <- readTVar $ connected c'
                    pure $ if yes then Just (qId, c') else Nothing
-          TM.lookupInsert qId clnt (subs s)
+          stateTVar (subs s) (\cs -> (M.lookup qId cs, M.insert qId clnt cs))
            >>= fmap join . mapM clientToBeNotified
-        endPreviousSubscriptions :: (QueueId, Client) -> m (Maybe s)
+        endPreviousSubscriptions :: (QueueId, Client) -> m' (Maybe s)
        endPreviousSubscriptions (qId, c) = do
          void . forkIO . atomically $
            writeTBQueue (sndQ c) (CorrId "", qId, END)
-          atomically $ TM.lookupDelete qId (clientSubs c)
+          atomically . stateTVar (clientSubs c) $ \ss -> (M.lookup qId ss, M.delete qId ss)

-    expireMessagesThread_ :: ServerConfig -> [m ()]
-    expireMessagesThread_ ServerConfig {messageTTL, expireMessagesInterval} =
-      case (messageTTL, expireMessagesInterval) of
-        (Just ttl, Just int) -> [expireMessages ttl int]
-        _ -> []
-
-    expireMessages :: Int64 -> Int -> m ()
-    expireMessages ttl interval = do
-      ms <- asks msgStore
-      quota <- asks $ msgQueueQuota . config
-      forever $ do
-        threadDelay interval
-        old <- subtract ttl . systemSeconds <$> liftIO getSystemTime
-        rIds <- M.keysSet <$> readTVarIO ms
-        forM_ rIds $ \rId ->
-          atomically (getMsgQueue ms rId quota)
-            >>= atomically . (`deleteExpiredMsgs` old)
-
-    runClient :: Transport c => TProxy c -> c -> m ()
+    runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
    runClient _ h = do
      kh <- asks serverIdentity
      liftIO (runExceptT $ serverHandshake h kh) >>= \case
@@ -157,7 +139,7 @@ clientDisconnected c@Client {subscriptions, connected} = do
  subs <- readTVarIO subscriptions
  mapM_ cancelSub subs
  cs <- asks $ subscribers . server
-  atomically . mapM_ (\rId -> TM.update deleteCurrentClient rId cs) $ M.keys subs
+  atomically . mapM_ (modifyTVar cs . M.update deleteCurrentClient) $ M.keys subs
  where
    deleteCurrentClient :: Client -> Maybe Client
    deleteCurrentClient c'
@@ -248,11 +230,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
        Cmd SNotifier NSUB -> subscribeNotifications
        Cmd SRecipient command ->
          case command of
-            NEW rKey dhKey ->
-              ifM
-                (asks $ allowNewQueues . config)
-                (createQueue st rKey dhKey)
-                (pure (corrId, queueId, ERR AUTH))
+            NEW rKey dhKey -> createQueue st rKey dhKey
            SUB -> subscribeQueue queueId
            ACK -> acknowledgeMsg
            KEY sKey -> secureQueue_ st sKey
@@ -331,19 +309,21 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri

        getSubscription :: RecipientId -> STM Sub
        getSubscription rId = do
-          TM.lookup rId subscriptions >>= \case
+          subs <- readTVar subscriptions
+          case M.lookup rId subs of
            Just s -> tryTakeTMVar (delivered s) $> s
            Nothing -> do
              writeTBQueue subscribedQ (rId, clnt)
              s <- newSubscription
-              TM.insert rId s subscriptions
+              writeTVar subscriptions $ M.insert rId s subs
              return s

        subscribeNotifications :: m (Transmission BrokerMsg)
        subscribeNotifications = atomically $ do
-          whenM (isNothing <$> TM.lookup queueId ntfSubscriptions) $ do
+          subs <- readTVar ntfSubscriptions
+          when (isNothing $ M.lookup queueId subs) $ do
            writeTBQueue ntfSubscribedQ (queueId, clnt)
-            TM.insert queueId () ntfSubscriptions
+            writeTVar ntfSubscriptions $ M.insert queueId () subs
          pure ok

        acknowledgeMsg :: m (Transmission BrokerMsg)
@@ -354,7 +334,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
              _ -> return $ err NO_MSG

        withSub :: RecipientId -> (Sub -> STM a) -> STM (Maybe a)
-        withSub rId f = mapM f =<< TM.lookup rId subscriptions
+        withSub rId f = readTVar subscriptions >>= mapM f . M.lookup rId

        sendMessage :: QueueStore -> MsgBody -> m (Transmission BrokerMsg)
        sendMessage st msgBody
@@ -371,11 +351,9 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
                  Left _ -> pure $ err LARGE_MSG
                  Right msg -> do
                    ms <- asks msgStore
-                    ServerConfig {messageTTL, msgQueueQuota} <- asks config
-                    old <- forM messageTTL $ \ttl -> subtract ttl . systemSeconds <$> liftIO getSystemTime
+                    quota <- asks $ msgQueueQuota . config
                    atomically $ do
-                      q <- getMsgQueue ms (recipientId qr) msgQueueQuota
-                      mapM_ (deleteExpiredMsgs q) old
+                      q <- getMsgQueue ms (recipientId qr) quota
                      ifM (isFull q) (pure $ err QUOTA) $ do
                        trySendNotification
                        writeMsg q msg
@@ -391,7 +369,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
                trySendNotification :: STM ()
                trySendNotification =
                  forM_ (notifier qr) $ \(nId, _) ->
-                    mapM_ (writeNtf nId) =<< TM.lookup nId notifiers
+                    mapM_ (writeNtf nId) . M.lookup nId =<< readTVar notifiers

                writeNtf :: NotifierId -> Client -> STM ()
                writeNtf nId Client {sndQ = q} =
@@ -425,7 +403,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
              void setDelivered

            setSub :: (Sub -> Sub) -> STM ()
-            setSub f = TM.adjust f rId subscriptions
+            setSub f = modifyTVar subscriptions $ M.adjust f rId

            setDelivered :: STM (Maybe Bool)
            setDelivered = withSub rId $ \s -> tryPutTMVar (delivered s) ()
@@ -9,7 +9,6 @@ import Control.Concurrent (ThreadId)
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
-import Data.Int (Int64)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.X509.Validation (Fingerprint (..))
@@ -22,8 +21,6 @@ import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.QueueStore (QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport)
 import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
 import System.IO (IOMode (..))
@@ -37,12 +34,6 @@ data ServerConfig = ServerConfig
    queueIdBytes :: Int,
    msgIdBytes :: Int,
    storeLog :: Maybe (StoreLog 'ReadMode),
-    -- | set to False to prohibit creating new queues
-    allowNewQueues :: Bool,
-    -- | time after which the messages can be removed from the queues, seconds
-    messageTTL :: Maybe Int64,
-    -- | interval to periodically remove expired messages (when no messages are sent to the queue), microseconds
-    expireMessagesInterval :: Maybe Int,
    -- CA certificate private key is not needed for initialization
    caCertificateFile :: FilePath,
    privateKeyFile :: FilePath,
@@ -62,14 +53,14 @@ data Env = Env

 data Server = Server
  { subscribedQ :: TBQueue (RecipientId, Client),
-    subscribers :: TMap RecipientId Client,
+    subscribers :: TVar (Map RecipientId Client),
    ntfSubscribedQ :: TBQueue (NotifierId, Client),
-    notifiers :: TMap NotifierId Client
+    notifiers :: TVar (Map NotifierId Client)
  }

 data Client = Client
-  { subscriptions :: TMap RecipientId Sub,
-    ntfSubscriptions :: TMap NotifierId (),
+  { subscriptions :: TVar (Map RecipientId Sub),
+    ntfSubscriptions :: TVar (Map NotifierId ()),
    rcvQ :: TBQueue (Transmission Cmd),
    sndQ :: TBQueue (Transmission BrokerMsg),
    sessionId :: ByteString,
@@ -86,15 +77,15 @@ data Sub = Sub
 newServer :: Natural -> STM Server
 newServer qSize = do
  subscribedQ <- newTBQueue qSize
-  subscribers <- TM.empty
+  subscribers <- newTVar M.empty
  ntfSubscribedQ <- newTBQueue qSize
-  notifiers <- TM.empty
+  notifiers <- newTVar M.empty
  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers}

 newClient :: Natural -> ByteString -> STM Client
 newClient qSize sessionId = do
-  subscriptions <- TM.empty
-  ntfSubscriptions <- TM.empty
+  subscriptions <- newTVar M.empty
+  ntfSubscriptions <- newTVar M.empty
  rcvQ <- newTBQueue qSize
  sndQ <- newTBQueue qSize
  connected <- newTVar True
@@ -118,12 +109,15 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile}
  return Env {config, server, serverIdentity, queueStore, msgStore, idsDrg, storeLog = s', tlsServerParams}
  where
    restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)
-    restoreQueues QueueStore {queues, senders, notifiers} s = do
-      (qs, s') <- liftIO $ readWriteStoreLog s
-      atomically $ do
-        writeTVar queues =<< mapM newTVar qs
-        writeTVar senders $ M.foldr' addSender M.empty qs
-        writeTVar notifiers $ M.foldr' addNotifier M.empty qs
+    restoreQueues queueStore s = do
+      (queues, s') <- liftIO $ readWriteStoreLog s
+      atomically $
+        modifyTVar queueStore $ \d ->
+          d
+            { queues,
+              senders = M.foldr' addSender M.empty queues,
+              notifiers = M.foldr' addNotifier M.empty queues
+            }
      pure s'
    addSender :: QueueRec -> Map SenderId RecipientId -> Map SenderId RecipientId
    addSender q = M.insert (senderId q) (recipientId q)
@@ -2,7 +2,6 @@

 module Simplex.Messaging.Server.MsgStore where

-import Data.Int (Int64)
 import Data.Time.Clock.System (SystemTime)
 import Numeric.Natural
 import Simplex.Messaging.Protocol (MsgBody, MsgId, RecipientId)
@@ -23,4 +22,3 @@ class MonadMsgQueue q m where
  tryPeekMsg :: q -> m (Maybe Message) -- non blocking
  peekMsg :: q -> m Message -- blocking
  tryDelPeekMsg :: q -> m (Maybe Message) -- atomic delete (== read) last and peek next message, if available
-  deleteExpiredMsgs :: q -> Int64 -> m ()
@@ -3,38 +3,39 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}

 module Simplex.Messaging.Server.MsgStore.STM where

-import Control.Monad (when)
-import Data.Int (Int64)
-import Data.Time.Clock.System (SystemTime (systemSeconds))
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Numeric.Natural
 import Simplex.Messaging.Protocol (RecipientId)
 import Simplex.Messaging.Server.MsgStore
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
 import UnliftIO.STM

 newtype MsgQueue = MsgQueue {msgQueue :: TBQueue Message}

-type STMMsgStore = TMap RecipientId MsgQueue
+newtype MsgStoreData = MsgStoreData {messages :: Map RecipientId MsgQueue}
+
+type STMMsgStore = TVar MsgStoreData

 newMsgStore :: STM STMMsgStore
-newMsgStore = TM.empty
+newMsgStore = newTVar $ MsgStoreData M.empty

 instance MonadMsgStore STMMsgStore MsgQueue STM where
  getMsgQueue :: STMMsgStore -> RecipientId -> Natural -> STM MsgQueue
-  getMsgQueue st rId quota = maybe newQ pure =<< TM.lookup rId st
+  getMsgQueue store rId quota = do
+    m <- messages <$> readTVar store
+    maybe (newQ m) return $ M.lookup rId m
    where
-      newQ = do
+      newQ m' = do
        q <- MsgQueue <$> newTBQueue quota
-        TM.insert rId q st
+        writeTVar store . MsgStoreData $ M.insert rId q m'
        return q

  delMsgQueue :: STMMsgStore -> RecipientId -> STM ()
-  delMsgQueue st rId = TM.delete rId st
+  delMsgQueue store rId =
+    modifyTVar store $ MsgStoreData . M.delete rId . messages

 instance MonadMsgQueue MsgQueue STM where
  isFull :: MsgQueue -> STM Bool
@@ -52,11 +53,3 @@ instance MonadMsgQueue MsgQueue STM where
  -- atomic delete (== read) last and peek next message if available
  tryDelPeekMsg :: MsgQueue -> STM (Maybe Message)
  tryDelPeekMsg (MsgQueue q) = tryReadTBQueue q >> tryPeekTBQueue q
-
-  deleteExpiredMsgs :: MsgQueue -> Int64 -> STM ()
-  deleteExpiredMsgs (MsgQueue q) old = loop
-    where
-      loop = tryPeekTBQueue q >>= mapM_ delOldMsg
-      delOldMsg Message {ts} =
-        when (systemSeconds ts < old) $
-          tryReadTBQueue q >> loop
@@ -15,7 +15,6 @@ data QueueRec = QueueRec
    notifier :: Maybe (NotifierId, NtfPublicVerifyKey),
    status :: QueueStatus
  }
-  deriving (Eq, Show)

 data QueueStatus = QueueActive | QueueOff deriving (Eq, Show)

@@ -3,7 +3,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
@@ -12,83 +11,107 @@

 module Simplex.Messaging.Server.QueueStore.STM where

-import Control.Monad
-import Data.Functor (($>))
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (ifM)
 import UnliftIO.STM

-data QueueStore = QueueStore
-  { queues :: TMap RecipientId (TVar QueueRec),
-    senders :: TMap SenderId RecipientId,
-    notifiers :: TMap NotifierId RecipientId
+data QueueStoreData = QueueStoreData
+  { queues :: Map RecipientId QueueRec,
+    senders :: Map SenderId RecipientId,
+    notifiers :: Map NotifierId RecipientId
  }

+type QueueStore = TVar QueueStoreData
+
 newQueueStore :: STM QueueStore
-newQueueStore = do
-  queues <- TM.empty
-  senders <- TM.empty
-  notifiers <- TM.empty
-  pure QueueStore {queues, senders, notifiers}
+newQueueStore = newTVar QueueStoreData {queues = M.empty, senders = M.empty, notifiers = M.empty}

 instance MonadQueueStore QueueStore STM where
  addQueue :: QueueStore -> QueueRec -> STM (Either ErrorType ())
-  addQueue QueueStore {queues, senders} q@QueueRec {recipientId = rId, senderId = sId} = do
-    ifM hasId (pure $ Left DUPLICATE_) $ do
-      qVar <- newTVar q
-      TM.insert rId qVar queues
-      TM.insert sId rId senders
-      pure $ Right ()
-    where
-      hasId = (||) <$> TM.member rId queues <*> TM.member sId senders
+  addQueue store qRec@QueueRec {recipientId = rId, senderId = sId} = do
+    cs@QueueStoreData {queues, senders} <- readTVar store
+    if M.member rId queues || M.member sId senders
+      then return $ Left DUPLICATE_
+      else do
+        writeTVar store $
+          cs
+            { queues = M.insert rId qRec queues,
+              senders = M.insert sId rId senders
+            }
+        return $ Right ()

  getQueue :: QueueStore -> SParty p -> QueueId -> STM (Either ErrorType QueueRec)
-  getQueue QueueStore {queues, senders, notifiers} party qId =
-    toResult <$> (mapM readTVar =<< getVar)
+  getQueue st party qId = do
+    cs <- readTVar st
+    pure $ case party of
+      SRecipient -> getRcpQueue cs qId
+      SSender -> getPartyQueue cs senders
+      SNotifier -> getPartyQueue cs notifiers
    where
-      getVar = case party of
-        SRecipient -> TM.lookup qId queues
-        SSender -> TM.lookup qId senders >>= get
-        SNotifier -> TM.lookup qId notifiers >>= get
-      get = fmap join . mapM (`TM.lookup` queues)
+      getPartyQueue ::
+        QueueStoreData ->
+        (QueueStoreData -> Map QueueId RecipientId) ->
+        Either ErrorType QueueRec
+      getPartyQueue cs recipientIds =
+        case M.lookup qId $ recipientIds cs of
+          Just rId -> getRcpQueue cs rId
+          Nothing -> Left AUTH

  secureQueue :: QueueStore -> RecipientId -> SndPublicVerifyKey -> STM (Either ErrorType QueueRec)
-  secureQueue QueueStore {queues} rId sKey =
-    withQueue rId queues $ \qVar ->
-      readTVar qVar >>= \q -> case senderKey q of
-        Just _ -> pure Nothing
-        _ -> writeTVar qVar q {senderKey = Just sKey} $> Just q
+  secureQueue store rId sKey =
+    updateQueues store rId $ \cs c ->
+      case senderKey c of
+        Just _ -> (Left AUTH, cs)
+        _ -> (Right c, cs {queues = M.insert rId c {senderKey = Just sKey} (queues cs)})

  addQueueNotifier :: QueueStore -> RecipientId -> NotifierId -> NtfPublicVerifyKey -> STM (Either ErrorType QueueRec)
-  addQueueNotifier QueueStore {queues, notifiers} rId nId nKey = do
-    ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $
-      withQueue rId queues $ \qVar ->
-        readTVar qVar >>= \q -> case notifier q of
-          Just _ -> pure Nothing
+  addQueueNotifier store rId nId nKey = do
+    cs@QueueStoreData {queues, notifiers} <- readTVar store
+    if M.member nId notifiers
+      then pure $ Left DUPLICATE_
+      else case M.lookup rId queues of
+        Nothing -> pure $ Left AUTH
+        Just q -> case notifier q of
+          Just _ -> pure $ Left AUTH
          _ -> do
-            writeTVar qVar q {notifier = Just (nId, nKey)}
-            TM.insert nId rId notifiers
-            pure $ Just q
+            writeTVar store $
+              cs
+                { queues = M.insert rId q {notifier = Just (nId, nKey)} queues,
+                  notifiers = M.insert nId rId notifiers
+                }
+            pure $ Right q

  suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ())
-  suspendQueue QueueStore {queues} rId =
-    withQueue rId queues $ \qVar -> modifyTVar' qVar (\q -> q {status = QueueOff}) $> Just ()
+  suspendQueue store rId =
+    updateQueues store rId $ \cs c ->
+      (Right (), cs {queues = M.insert rId c {status = QueueOff} (queues cs)})

  deleteQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ())
-  deleteQueue QueueStore {queues, senders, notifiers} rId = do
-    TM.lookupDelete rId queues >>= \case
-      Just qVar ->
-        readTVar qVar >>= \q -> do
-          TM.delete (senderId q) senders
-          forM_ (notifier q) $ \(nId, _) -> TM.delete nId notifiers
-          pure $ Right ()
-      _ -> pure $ Left AUTH
+  deleteQueue store rId =
+    updateQueues store rId $ \cs c ->
+      ( Right (),
+        cs
+          { queues = M.delete rId (queues cs),
+            senders = M.delete (senderId c) (senders cs)
+          }
+      )

-toResult :: Maybe a -> Either ErrorType a
-toResult = maybe (Left AUTH) Right
+updateQueues ::
+  QueueStore ->
+  RecipientId ->
+  (QueueStoreData -> QueueRec -> (Either ErrorType a, QueueStoreData)) ->
+  STM (Either ErrorType a)
+updateQueues store rId update = do
+  cs <- readTVar store
+  let conn = getRcpQueue cs rId
+  either (return . Left) (_update cs) conn
+  where
+    _update cs c = do
+      let (res, cs') = update cs c
+      writeTVar store cs'
+      return res

-withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM (Maybe a)) -> STM (Either ErrorType a)
-withQueue rId queues f = toResult <$> (TM.lookup rId queues >>= fmap join . mapM f)
+getRcpQueue :: QueueStoreData -> RecipientId -> Either ErrorType QueueRec
+getRcpQueue cs rId = maybe (Left AUTH) Right . M.lookup rId $ queues cs
@@ -1,70 +0,0 @@
-module Simplex.Messaging.TMap
-  ( TMap,
-    empty,
-    singleton,
-    Simplex.Messaging.TMap.lookup,
-    member,
-    insert,
-    delete,
-    lookupInsert,
-    lookupDelete,
-    adjust,
-    update,
-    alter,
-    union,
-  )
-where
-
-import Control.Concurrent.STM
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-
-type TMap k a = TVar (Map k a)
-
-empty :: STM (TMap k a)
-empty = newTVar M.empty
-{-# INLINE empty #-}
-
-singleton :: k -> a -> STM (TMap k a)
-singleton k v = newTVar $ M.singleton k v
-{-# INLINE singleton #-}
-
-lookup :: Ord k => k -> TMap k a -> STM (Maybe a)
-lookup k m = M.lookup k <$> readTVar m
-{-# INLINE lookup #-}
-
-member :: Ord k => k -> TMap k a -> STM Bool
-member k m = M.member k <$> readTVar m
-{-# INLINE member #-}
-
-insert :: Ord k => k -> a -> TMap k a -> STM ()
-insert k v m = modifyTVar' m $ M.insert k v
-{-# INLINE insert #-}
-
-delete :: Ord k => k -> TMap k a -> STM ()
-delete k m = modifyTVar' m $ M.delete k
-{-# INLINE delete #-}
-
-lookupInsert :: Ord k => k -> a -> TMap k a -> STM (Maybe a)
-lookupInsert k v m = stateTVar m $ \mv -> (M.lookup k mv, M.insert k v mv)
-{-# INLINE lookupInsert #-}
-
-lookupDelete :: Ord k => k -> TMap k a -> STM (Maybe a)
-lookupDelete k m = stateTVar m $ \mv -> (M.lookup k mv, M.delete k mv)
-{-# INLINE lookupDelete #-}
-
-adjust :: Ord k => (a -> a) -> k -> TMap k a -> STM ()
-adjust f k m = modifyTVar' m $ M.adjust f k
-{-# INLINE adjust #-}
-
-update :: Ord k => (a -> Maybe a) -> k -> TMap k a -> STM ()
-update f k m = modifyTVar' m $ M.update f k
-{-# INLINE update #-}
-
-alter :: Ord k => (Maybe a -> Maybe a) -> k -> TMap k a -> STM ()
-alter f k m = modifyTVar' m $ M.alter f k
-{-# INLINE alter #-}
-
-union :: Ord k => Map k a -> TMap k a -> STM ()
-union m' m = modifyTVar' m $ M.union m'
-{-# INLINE union #-}
@@ -38,7 +38,6 @@ module Simplex.Messaging.Transport

    -- * TLS Transport
    TLS (..),
-    SessionId,
    connectTLS,
    closeTLS,
    supportedParameters,
@@ -97,7 +96,7 @@ supportedSMPVersions :: VersionRange
 supportedSMPVersions = mkVersionRange 1 1

 simplexMQVersion :: String
-simplexMQVersion = "1.1.0"
+simplexMQVersion = "1.0.3"

 -- * Transport connection class

@@ -116,7 +115,7 @@ class Transport c where
  getClientConnection :: T.Context -> IO c

  -- | tls-unique channel binding per RFC5929
-  tlsUnique :: c -> SessionId
+  tlsUnique :: c -> ByteString

  -- | Close connection
  closeConnection :: c -> IO ()
@@ -251,17 +250,14 @@ trimCR s = if B.last s == '\r' then B.init s else s
 -- | The handle for SMP encrypted transport connection over Transport .
 data THandle c = THandle
  { connection :: c,
-    sessionId :: SessionId,
+    sessionId :: ByteString,
    -- | agreed SMP server protocol version
    smpVersion :: Version
  }

-- | TLS-unique channel binding
-type SessionId = ByteString
-
 data ServerHandshake = ServerHandshake
  { smpVersionRange :: VersionRange,
-    sessionId :: SessionId
+    sessionId :: ByteString
  }

 data ClientHandshake = ClientHandshake
@@ -20,20 +20,19 @@ import Network.Socket
 import qualified Network.TLS as T
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.KeepAlive
 import System.IO.Error
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E

 -- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
-runTransportClient host port keyHash keepAliveOpts client = do
+runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> C.KeyHash -> (c -> m a) -> m a
+runTransportClient host port keyHash client = do
  let clientParams = mkTLSClientParams host port keyHash
-  c <- liftIO $ startTCPClient host port clientParams keepAliveOpts
+  c <- liftIO $ startTCPClient host port clientParams
  client c `E.finally` liftIO (closeConnection c)

-startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> Maybe KeepAliveOpts -> IO c
-startTCPClient host port clientParams keepAliveOpts = withSocketsDo $ resolve >>= tryOpen err
+startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> IO c
+startTCPClient host port clientParams = withSocketsDo $ resolve >>= tryOpen err
  where
    err :: IOException
    err = mkIOError NoSuchThing "no address" Nothing Nothing
@@ -52,7 +51,6 @@ startTCPClient host port clientParams keepAliveOpts = withSocketsDo $ resolve >>
    open addr = do
      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
      connect sock $ addrAddress addr
-      mapM_ (setSocketKeepAlive sock) keepAliveOpts
      ctx <- connectTLS clientParams sock
      getClientConnection ctx

@@ -77,7 +75,7 @@ validateCertificateChain (C.KeyHash kh) host port cc@(X.CertificateChain sc@[_,
    x509validate = XV.validate X.HashSHA256 hooks checks certStore cache serviceID cc
      where
        hooks = XV.defaultHooks
-        checks = XV.defaultChecks
+        checks = XV.defaultChecks {XV.checkFQHN = False}
        certStore = XS.makeCertificateStore sc
        cache = XV.exceptionValidationCache [] -- we manually check fingerprint only of the identity certificate (ca.crt)
        serviceID = (host, port)
@@ -1,62 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE NamedFieldPuns #-}
-
-module Simplex.Messaging.Transport.KeepAlive where
-
-import Foreign.C (CInt (..))
-import Network.Socket
-
-data KeepAliveOpts = KeepAliveOpts
-  { keepIdle :: Int,
-    keepIntvl :: Int,
-    keepCnt :: Int
-  }
-
-defaultKeepAliveOpts :: KeepAliveOpts
-defaultKeepAliveOpts =
-  KeepAliveOpts
-    { keepIdle = 30,
-      keepIntvl = 15,
-      keepCnt = 4
-    }
-
-_SOL_TCP :: CInt
-_SOL_TCP = 6
-
-#if defined(mingw32_HOST_OS)
-- Windows
-
-- The values are copied from windows::Win32::Networking::WinSock
-- https://microsoft.github.io/windows-docs-rs/doc/windows/Win32/Networking/WinSock/index.html
-
-_TCP_KEEPIDLE :: CInt
-_TCP_KEEPIDLE = 3
-
-_TCP_KEEPINTVL :: CInt
-_TCP_KEEPINTVL = 17
-
-_TCP_KEEPCNT :: CInt
-_TCP_KEEPCNT = 16
-
-#else
-- Mac/Linux
-
-#if defined(darwin_HOST_OS)
-foreign import capi "netinet/tcp.h value TCP_KEEPALIVE" _TCP_KEEPIDLE :: CInt
-#else
-foreign import capi "netinet/tcp.h value TCP_KEEPIDLE" _TCP_KEEPIDLE :: CInt
-#endif
-
-foreign import capi "netinet/tcp.h value TCP_KEEPINTVL" _TCP_KEEPINTVL :: CInt
-
-foreign import capi "netinet/tcp.h value TCP_KEEPCNT" _TCP_KEEPCNT :: CInt
-
-#endif
-
-setSocketKeepAlive :: Socket -> KeepAliveOpts -> IO ()
-setSocketKeepAlive sock KeepAliveOpts {keepCnt, keepIdle, keepIntvl} = do
-  setSocketOption sock KeepAlive 1
-  setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPIDLE) keepIdle
-  setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPINTVL) keepIntvl
-  setSocketOption sock (SockOpt _SOL_TCP _TCP_KEEPCNT) keepCnt
@@ -4,7 +4,6 @@

 module Simplex.Messaging.Transport.Server
  ( runTransportServer,
-    runTCPServer,
    loadTLSServerParams,
    loadFingerprint,
    serverHandshake,
@@ -38,11 +37,11 @@ runTransportServer started port serverParams server = do
    clients <- newTVarIO S.empty
    E.bracket
      (startTCPServer started port)
-      (closeServer started clients)
+      (closeServer clients)
      $ \sock -> forever $ do
        (connSock, _) <- accept sock
        tid <- forkIO $ connectClient u connSock `E.catch` \(_ :: E.SomeException) -> pure ()
-        atomically . modifyTVar' clients $ S.insert tid
+        atomically . modifyTVar clients $ S.insert tid
  where
    connectClient :: UnliftIO m -> Socket -> IO ()
    connectClient u connSock =
@@ -50,23 +49,11 @@ runTransportServer started port serverParams server = do
        (connectTLS serverParams connSock >>= getServerConnection)
        closeConnection
        (unliftIO u . server)
-
-runTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
-runTCPServer started port server = do
-  clients <- newTVarIO S.empty
-  E.bracket
-    (startTCPServer started port)
-    (closeServer started clients)
-    $ \sock -> forever $ do
-      (connSock, _) <- accept sock
-      tid <- forkIO $ server connSock `E.catch` \(_ :: E.SomeException) -> pure ()
-      atomically . modifyTVar' clients $ S.insert tid
-
-closeServer :: TMVar Bool -> TVar (Set ThreadId) -> Socket -> IO ()
-closeServer started clients sock = do
-  readTVarIO clients >>= mapM_ killThread
-  close sock
-  void . atomically $ tryPutTMVar started False
+    closeServer :: TVar (Set ThreadId) -> Socket -> IO ()
+    closeServer clients sock = do
+      readTVarIO clients >>= mapM_ killThread
+      close sock
+      void . atomically $ tryPutTMVar started False

 startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
 startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
@@ -58,10 +58,6 @@ ifM :: Monad m => m Bool -> m a -> m a -> m a
 ifM ba t f = ba >>= \b -> if b then t else f
 {-# INLINE ifM #-}

-whenM :: Monad m => m Bool -> m () -> m ()
-whenM b a = ifM b a $ pure ()
-{-# INLINE whenM #-}
-
 unlessM :: Monad m => m Bool -> m () -> m ()
 unlessM b = ifM b $ pure ()
 {-# INLINE unlessM #-}
@@ -36,7 +36,6 @@ packages:
 #
 extra-deps:
  - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
-  - network-3.1.2.7@sha256:e3d78b13db9512aeb106e44a334ab42b7aa48d26c097299084084cb8be5c5568,4888
  - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
  - tls-1.5.7@sha256:1cc30253a9696b65a9cafc0317fbf09f7dcea15e3a145ed6c9c0e28c632fa23a,6991
 # below dependancies are to update Aeson to 2.0.3
@@ -468,7 +468,7 @@ syntaxTests t = do
          "a",
          "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2F"
            <> urlEncode True "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
-            <> "%40localhost%3A5001%2F3456-w%3D%3D%23"
+            <> "%40127.0.0.1%3A5001%2F3456-w%3D%3D%23"
            <> urlEncode True sampleDhKey
            <> "&v=1"
            <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
@@ -27,7 +27,6 @@ import Simplex.Messaging.Agent.Server (runSMPAgentBlocking)
 import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
-import Simplex.Messaging.Transport.KeepAlive
 import Test.Hspec
 import UnliftIO.Concurrent
 import UnliftIO.Directory
@@ -158,7 +157,7 @@ cfg :: AgentConfig
 cfg =
  defaultAgentConfig
    { tcpPort = agentTestPort,
-      initialSMPServers = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
+      initialSMPServers = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@127.0.0.1:5001"],
      tbqSize = 1,
      dbFile = testDB,
      smpCfg =
@@ -175,7 +174,7 @@ cfg =

 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
 withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
-  let cfg' = cfg {tcpPort = port', dbFile = db', initialSMPServers = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
+  let cfg' = cfg {tcpPort = port', dbFile = db', initialSMPServers = L.fromList [SMPServer "127.0.0.1" smpPort' testKeyHash]}
   in serverBracket
        (\started -> runSMPAgentBlocking t started cfg')
        afterProcess
@@ -191,7 +190,7 @@ withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)

 testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a
 testSMPAgentClientOn port' client = do
-  runTransportClient agentTestHost port' testKeyHash (Just defaultKeepAliveOpts) $ \h -> do
+  runTransportClient agentTestHost port' testKeyHash $ \h -> do
    line <- liftIO $ getLn h
    if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion
      then client h
@@ -22,7 +22,6 @@ import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (openReadStoreLog)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
-import Simplex.Messaging.Transport.KeepAlive
 import Test.Hspec
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
@@ -30,7 +29,7 @@ import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, takeTMVar)
 import UnliftIO.Timeout (timeout)

 testHost :: HostName
-testHost = "localhost"
+testHost = "127.0.0.1"

 testPort :: ServiceName
 testPort = "5001"
@@ -46,7 +45,7 @@ testStoreLogFile = "tests/tmp/smp-server-store.log"

 testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
-  runTransportClient testHost testPort testKeyHash (Just defaultKeepAliveOpts) $ \h ->
+  runTransportClient testHost testPort testKeyHash $ \h ->
    liftIO (runExceptT $ clientHandshake h testKeyHash) >>= \case
      Right th -> client th
      Left e -> error $ show e
@@ -61,9 +60,6 @@ cfg =
      queueIdBytes = 24,
      msgIdBytes = 24,
      storeLog = Nothing,
-      allowNewQueues = True,
-      messageTTL = Just $ 7 * 86400, -- seconds, 7 days
-      expireMessagesInterval = Just 21600_000000, -- microseconds, 6 hours
      caCertificateFile = "tests/fixtures/ca.crt",
      privateKeyFile = "tests/fixtures/server.key",
      certificateFile = "tests/fixtures/server.crt"
@@ -72,16 +68,16 @@ cfg =
 withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
 withSmpServerStoreLogOn t port' client = do
  s <- liftIO $ openReadStoreLog testStoreLogFile
-  withSmpServerConfigOn t cfg {storeLog = Just s} port' client
-
-withSmpServerConfigOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServerConfig -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerConfigOn t cfg' port' =
  serverBracket
-    (\started -> runSMPServerBlocking started cfg' {transports = [(port', t)]})
+    (\started -> runSMPServerBlocking started cfg {transports = [(port', t)], storeLog = Just s})
    (pure ())
+    client

 withSmpServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerThreadOn t = withSmpServerConfigOn t cfg
+withSmpServerThreadOn t port' =
+  serverBracket
+    (\started -> runSMPServerBlocking started cfg {transports = [(port', t)]})
+    (pure ())

 serverBracket :: MonadUnliftIO m => (TMVar Bool -> m ()) -> m () -> (ThreadId -> m a) -> m a
 serverBracket process afterProcess f = do
@@ -9,7 +9,7 @@

 module ServerTests where

-import Control.Concurrent (ThreadId, killThread, threadDelay)
+import Control.Concurrent (ThreadId, killThread)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
 import Control.Monad.Except (forM, forM_, runExceptT)
@@ -21,7 +21,6 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport
 import System.Directory (removeFile)
 import System.TimeIt (timeItT)
@@ -30,23 +29,18 @@ import Test.HUnit
 import Test.Hspec

 serverTests :: ATransport -> Spec
-serverTests t@(ATransport t') = do
+serverTests t = do
  describe "SMP syntax" $ syntaxTests t
  describe "SMP queues" $ do
    describe "NEW and KEY commands, SEND messages" $ testCreateSecure t
    describe "NEW, OFF and DEL commands, SEND messages" $ testCreateDelete t
    describe "Stress test" $ stressTest t
-    describe "allowNewQueues setting" $ testAllowNewQueues t'
  describe "SMP messages" $ do
    describe "duplex communication over 2 SMP connections" $ testDuplex t
    describe "switch subscription to another TCP connection" $ testSwitchSub t
  describe "Store log" $ testWithStoreLog t
  describe "Timing of AUTH error" $ testTiming t
  describe "Message notifications" $ testMessageNotifications t
-  describe "Message expiration" $ do
-    testMsgExpireOnSend t'
-    testMsgExpireOnInterval t'
-    testMsgNOTExpireOnInterval t'

 pattern Resp :: CorrId -> QueueId -> BrokerMsg -> SignedTransmission BrokerMsg
 pattern Resp corrId queueId command <- (_, _, (corrId, queueId, Right command))
@@ -210,16 +204,6 @@ stressTest (ATransport t) =
      closeConnection $ connection h2
      subscribeQueues h3

-testAllowNewQueues :: forall c. Transport c => TProxy c -> Spec
-testAllowNewQueues t =
-  it "should prohibit creating new queues with allowNewQueues = False" $ do
-    withSmpServerConfigOn (ATransport t) cfg {allowNewQueues = False} testPort $ \_ ->
-      testSMPClient @c $ \h -> do
-        (rPub, rKey) <- C.generateSignatureKeyPair C.SEd448
-        (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair'
-        Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub)
-        pure ()
-
 testDuplex :: ATransport -> Spec
 testDuplex (ATransport t) =
  it "should create 2 simplex connections and exchange messages" $
@@ -482,56 +466,6 @@ testMessageNotifications (ATransport t) =
        Nothing -> return ()
        Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection"

-testMsgExpireOnSend :: forall c. Transport c => TProxy c -> Spec
-testMsgExpireOnSend t =
-  it "should expire messages that are not received before messageTTL on SEND" $ do
-    (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
-    withSmpServerConfigOn (ATransport t) cfg {messageTTL = Just 1} testPort $ \_ ->
-      testSMPClient @c $ \sh -> do
-        (sId, rId, rKey, dhShared) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
-        let dec nonce = C.cbDecrypt dhShared (C.cbNonce nonce)
-        Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, SEND "hello (should expire)")
-        threadDelay 2500000
-        Resp "2" _ OK <- signSendRecv sh sKey ("2", sId, SEND "hello (should NOT expire)")
-        testSMPClient @c $ \rh -> do
-          Resp "3" _ (MSG mId _ msg) <- signSendRecv rh rKey ("3", rId, SUB)
-          (dec mId msg, Right "hello (should NOT expire)") #== "delivered"
-          1000 `timeout` tGet @BrokerMsg rh >>= \case
-            Nothing -> return ()
-            Just _ -> error "nothing else should be delivered"
-
-testMsgExpireOnInterval :: forall c. Transport c => TProxy c -> Spec
-testMsgExpireOnInterval t =
-  it "should expire messages that are not received before messageTTL after expiry interval" $ do
-    (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
-    withSmpServerConfigOn (ATransport t) cfg {messageTTL = Just 1, expireMessagesInterval = Just 1000000} testPort $ \_ ->
-      testSMPClient @c $ \sh -> do
-        (sId, rId, rKey, _) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
-        Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, SEND "hello (should expire)")
-        threadDelay 2500000
-        testSMPClient @c $ \rh -> do
-          Resp "2" _ OK <- signSendRecv rh rKey ("2", rId, SUB)
-          1000 `timeout` tGet @BrokerMsg rh >>= \case
-            Nothing -> return ()
-            Just _ -> error "nothing should be delivered"
-
-testMsgNOTExpireOnInterval :: forall c. Transport c => TProxy c -> Spec
-testMsgNOTExpireOnInterval t =
-  it "should NOT expire messages that are not received before messageTTL if expiry interval is not set" $ do
-    (sPub, sKey) <- C.generateSignatureKeyPair C.SEd25519
-    withSmpServerConfigOn (ATransport t) cfg {messageTTL = Just 1, expireMessagesInterval = Nothing} testPort $ \_ ->
-      testSMPClient @c $ \sh -> do
-        (sId, rId, rKey, dhShared) <- testSMPClient @c $ \rh -> createAndSecureQueue rh sPub
-        let dec nonce = C.cbDecrypt dhShared (C.cbNonce nonce)
-        Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, SEND "hello (should NOT expire)")
-        threadDelay 2500000
-        testSMPClient @c $ \rh -> do
-          Resp "2" _ (MSG mId _ msg) <- signSendRecv rh rKey ("2", rId, SUB)
-          (dec mId msg, Right "hello (should NOT expire)") #== "delivered"
-          1000 `timeout` tGet @BrokerMsg rh >>= \case
-            Nothing -> return ()
-            Just _ -> error "nothing else should be delivered"
-
 samplePubKey :: C.APublicVerifyKey
 samplePubKey = C.APublicVerifyKey C.SEd25519 "MCowBQYDK2VwAyEAfAOflyvbJv1fszgzkQ6buiZJVgSpQWsucXq7U6zjMgY="
Author	SHA1	Message	Date
John Roberts	dfb0be2c0e	migration	2022-03-20 14:50:16 +04:00
John Roberts	2e808192de	use server IP addresses	2022-03-20 14:48:09 +04:00