rename simplexmq-legacy into simplexmq-v0 (#270 )

* rename simplexmq-legacy into simplexmq-v0 * split UnliftIO instance of ExceptT
update to use legacy name
2026-10-12 11:39:56 +00:00 · 2022-01-11 07:27:30 +00:00 · 2022-01-08 10:13:21 +00:00 · 2022-01-08 10:03:27 +00:00 · 2022-01-06 13:52:54 +00:00 · 2022-01-06 13:50:50 +00:00
34 changed files with 902 additions and 1537 deletions
@@ -4,6 +4,7 @@ on:
  push:
    branches:
      - master
+      - stable
    tags:
      - "v*"
  pull_request:
@@ -1,3 +1,11 @@
+# 0.5.2
+
+- Fix message delivery logic that blocked delivery of all server messages when server per-queue quota exceeded, making it concurrent per SMP queue, not per server.
+
+# 0.5.1
+
+- Fix server subscription logic bug that was leading to memory leak / resource exhaustion in some edge cases.
+
 # 0.5.0

 - No changes in SMP server implementation - it is backwards compatible with v0.4.1
@@ -3,6 +3,14 @@
 [![GitHub build](https://github.com/simplex-chat/simplexmq/workflows/build/badge.svg)](https://github.com/simplex-chat/simplexmq/actions?query=workflow%3Abuild)
 [![GitHub release](https://img.shields.io/github/v/release/simplex-chat/simplexmq)](https://github.com/simplex-chat/simplexmq/releases)

+📢 **v0.5.1 brings a hotfix to the server's subscription management logic, to apply it log in to your server via SSH and run the following command. If you have store log enabled for your server, information about already established queues will be preserved.** If you're doing a custom installation instead of Linode or DigitalOcean you may have to change the path for binary download.
+
+```sh
+systemctl stop smp-server
+curl -L -o /opt/simplex/bin/smp-server https://github.com/simplex-chat/simplexmq/releases/download/v0.5.1/smp-server-ubuntu-20_04-x86-64
+systemctl start smp-server
+```
+
 ## Message broker for unidirectional (simplex) queues

 SimpleXMQ is a message broker for managing message queues and sending messages over public network. It consists of SMP server, SMP client library and SMP agent that implement [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md) for client-server communication and [SMP agent protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md) to manage duplex connections via simplex queues on multiple SMP servers.
@@ -41,6 +41,7 @@ serverConfig :: ServerConfig
 serverConfig =
  ServerConfig
    { tbqSize = 16,
+      serverTbqSize = 128,
      msgQueueQuota = 256,
      queueIdBytes = 12,
      msgIdBytes = 6,
@@ -101,7 +102,7 @@ getConfig opts = do
  storeLog <- liftIO $ openStoreLog opts ini
  pure $ makeConfig ini pk storeLog

-makeConfig :: IniOpts -> C.PrivateKey 'C.RSA -> Maybe (StoreLog 'ReadMode) -> ServerConfig
+makeConfig :: IniOpts -> C.FullPrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig
 makeConfig IniOpts {serverPort, blockSize, enableWebsockets} pk storeLog =
  let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets]
   in serverConfig {serverPrivateKey = pk, storeLog, blockSize, transports}
@@ -200,11 +201,11 @@ createIni ServerOpts {enableStoreLog} = do
        enableWebsockets = True
      }

-readKey :: IniOpts -> ExceptT String IO (C.PrivateKey 'C.RSA)
+readKey :: IniOpts -> ExceptT String IO C.FullPrivateKey
 readKey IniOpts {serverKeyFile} = do
  fileExists serverKeyFile
  liftIO (S.readKeyFile serverKeyFile) >>= \case
-    [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.PrivateKeyRSA pk
+    [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk
    [_] -> err "not RSA key"
    [] -> err "invalid key file format"
    _ -> err "more than one key"
@@ -212,10 +213,10 @@ readKey IniOpts {serverKeyFile} = do
    err :: String -> ExceptT String IO b
    err e = throwE $ e <> ": " <> serverKeyFile

-createKey :: IniOpts -> IO (C.PrivateKey 'C.RSA)
+createKey :: IniOpts -> IO C.FullPrivateKey
 createKey IniOpts {serverKeyFile} = do
-  (_, pk) <- C.generateKeyPair' newKeySize C.SRSA
-  S.writeKeyFile S.TraditionalFormat serverKeyFile [C.privateToX509 pk]
+  (_, pk) <- C.generateKeyPair newKeySize
+  S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk]
  pure pk

 fileExists :: FilePath -> ExceptT String IO ()
@@ -233,8 +234,8 @@ confirm msg = do
  ok <- getLine
  when (map toLower ok /= "y") exitFailure

-serverKeyHash :: C.PrivateKey 'C.RSA -> B.ByteString
-serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey
+serverKeyHash :: C.FullPrivateKey -> B.ByteString
+serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey'

 openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
 openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}
@@ -1,5 +1,5 @@
-name: simplexmq
-version: 0.5.0
+name: simplexmq-v0
+version: 0.5.3
 synopsis: SimpleXMQ message broker
 description:  |
  This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -23,7 +23,7 @@ extra-source-files:
  - migrations/*.*

 dependencies:
-  - ansi-terminal >= 0.8 && < 0.12
+  - ansi-terminal >= 0.10 && < 0.12
  - asn1-encoding == 0.9.*
  - asn1-types == 0.3.*
  - async == 2.2.*
@@ -32,31 +32,31 @@ dependencies:
  - base64-bytestring >= 1.0 && < 1.3
  - bytestring == 0.10.*
  - composition == 1.0.*
-  - constraints >= 0.10 && < 0.14
-  - containers >= 0.5 && < 0.7
-  - cryptonite >= 0.25 && < 0.30
+  - constraints >= 0.12 && < 0.14
+  - containers == 0.6.*
+  - cryptonite >= 0.27 && < 0.30
  - direct-sqlite == 2.3.*
  - directory == 1.3.*
-  - file-embed >= 0.0.10.0 && <= 0.0.15.0
+  - file-embed >= 0.0.14.0 && <= 0.0.15.0
  - filepath == 1.4.*
  - http-types == 0.12.*
-  - generic-random >= 1.2 && < 1.5
+  - generic-random >= 1.3 && < 1.5
  - iso8601-time == 0.1.*
-  - memory >= 0.14 && < 0.16
+  - memory == 0.15.*
  - mtl == 2.2.*
-  - network >= 2.6 && < 3.2
+  - network == 3.1.*
  - network-transport == 0.5.*
-  - QuickCheck >= 2.11 && < 2.15
+  - QuickCheck == 2.14.*
  - random >= 1.1 && < 1.3
-  - simple-logger == 0.0.4
+  - simple-logger == 0.1.*
  - sqlite-simple == 0.4.*
-  - stm >= 2.4 && < 2.6
-  - template-haskell >= 2.13 && < 2.17
+  - stm == 2.5.*
+  - template-haskell == 2.16.*
  - text == 1.2.*
-  - time >= 1.8 && < 1.10
+  - time == 1.9.*
  - transformers == 0.5.*
  - unliftio == 0.2.*
-  - unliftio-core >= 0.1 && < 0.3
+  - unliftio-core == 0.2.*
  - websockets == 0.12.*
  - x509 == 1.7.*

@@ -69,9 +69,9 @@ executables:
    main: Main.hs
    dependencies:
      - cryptostore == 0.2.*
-      - ini >= 0.3 && < 0.5 
-      - optparse-applicative >= 0.14 && < 0.17
-      - simplexmq
+      - ini == 0.4.*
+      - optparse-applicative >= 0.15 && < 0.17
+      - simplexmq-v0
    ghc-options:
      - -threaded

@@ -79,7 +79,7 @@ executables:
    source-dirs: apps/smp-agent
    main: Main.hs
    dependencies:
-      - simplexmq
+      - simplexmq-v0
    ghc-options:
      - -threaded

@@ -88,11 +88,11 @@ tests:
    source-dirs: tests
    main: Test.hs
    dependencies:
-      - simplexmq
-      - hspec >= 2.5 && < 2.8
-      - hspec-core >= 2.5 && < 2.8
+      - simplexmq-v0
+      - hspec == 2.7.*
+      - hspec-core == 2.7.*
      - HUnit == 1.6.*
-      - QuickCheck >= 2.11 && < 2.15
+      - QuickCheck == 2.14.*
      - timeit == 2.0.*

 ghc-options:
@@ -1,18 +0,0 @@
-Scheme name: simplex
-
-Status: Provisional
-
-Applications/protocols that use this scheme name:
-This scheme is used for connection requests in SimpleX Agent Protocol,
-a middle layer protocol for managing bi-directional communication via
-redundant unidirectional SimpleX Messaging Protocol queues.
-
-Contact: Evgeny Poberezkin <[email protected]>
-
-Change controller: Evgeny Poberezkin <[email protected]>
-
-References:
-The syntax for connection requests in the latest version of SimpleX Agent Protocol:
-https://github.com/simplex-chat/simplexmq/blob/v5/protocol/agent-protocol.md#connection-request
-SimpleX Messaging Protocol:
-https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md
@@ -1,16 +0,0 @@
-Scheme name: smp
-
-Status: Provisional
-
-Applications/protocols that use this scheme name:
-This scheme is used for URIs of message queues in SimpleX Messaging Protocol,
-a client-server protocol for asynchronous distributed unidirectional
-message transmission via persistent message queues.
-
-Contact: Evgeny Poberezkin <[email protected]>
-
-Change controller: Evgeny Poberezkin <[email protected]>
-
-References:
-The syntax for message queue URIs in the latest version of SimpleX Messaging Protocol:
-https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md#smp-queue-uri
@@ -4,8 +4,8 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack

-name:           simplexmq
-version:        0.5.0
+name:           simplexmq-v0
+version:        0.5.3
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -37,6 +37,7 @@ library
      Simplex.Messaging.Agent
      Simplex.Messaging.Agent.Client
      Simplex.Messaging.Agent.Env.SQLite
+      Simplex.Messaging.Agent.ExceptT
      Simplex.Messaging.Agent.Protocol
      Simplex.Messaging.Agent.RetryInterval
      Simplex.Messaging.Agent.Store
@@ -57,13 +58,13 @@ library
      Simplex.Messaging.Transport.WebSockets
      Simplex.Messaging.Util
  other-modules:
-      Paths_simplexmq
+      Paths_simplexmq_v0
  hs-source-dirs:
      src
  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
  build-depends:
-      QuickCheck >=2.11 && <2.15
-    , ansi-terminal >=0.8 && <0.12
+      QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
    , asn1-encoding ==0.9.*
    , asn1-types ==0.3.*
    , async ==2.2.*
@@ -72,30 +73,30 @@ library
    , base64-bytestring >=1.0 && <1.3
    , bytestring ==0.10.*
    , composition ==1.0.*
-    , constraints >=0.10 && <0.14
-    , containers >=0.5 && <0.7
-    , cryptonite >=0.25 && <0.30
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
    , direct-sqlite ==2.3.*
    , directory ==1.3.*
-    , file-embed >=0.0.10.0 && <=0.0.15.0
+    , file-embed >=0.0.14.0 && <=0.0.15.0
    , filepath ==1.4.*
-    , generic-random >=1.2 && <1.5
+    , generic-random >=1.3 && <1.5
    , http-types ==0.12.*
    , iso8601-time ==0.1.*
-    , memory >=0.14 && <0.16
+    , memory ==0.15.*
    , mtl ==2.2.*
-    , network >=2.6 && <3.2
+    , network ==3.1.*
    , network-transport ==0.5.*
    , random >=1.1 && <1.3
-    , simple-logger ==0.0.4
+    , simple-logger ==0.1.*
    , sqlite-simple ==0.4.*
-    , stm >=2.4 && <2.6
-    , template-haskell >=2.13 && <2.17
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
    , text ==1.2.*
-    , time >=1.8 && <1.10
+    , time ==1.9.*
    , transformers ==0.5.*
    , unliftio ==0.2.*
-    , unliftio-core >=0.1 && <0.3
+    , unliftio-core ==0.2.*
    , websockets ==0.12.*
    , x509 ==1.7.*
  default-language: Haskell2010
@@ -103,13 +104,13 @@ library
 executable smp-agent
  main-is: Main.hs
  other-modules:
-      Paths_simplexmq
+      Paths_simplexmq_v0
  hs-source-dirs:
      apps/smp-agent
  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
  build-depends:
-      QuickCheck >=2.11 && <2.15
-    , ansi-terminal >=0.8 && <0.12
+      QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
    , asn1-encoding ==0.9.*
    , asn1-types ==0.3.*
    , async ==2.2.*
@@ -118,31 +119,31 @@ executable smp-agent
    , base64-bytestring >=1.0 && <1.3
    , bytestring ==0.10.*
    , composition ==1.0.*
-    , constraints >=0.10 && <0.14
-    , containers >=0.5 && <0.7
-    , cryptonite >=0.25 && <0.30
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
    , direct-sqlite ==2.3.*
    , directory ==1.3.*
-    , file-embed >=0.0.10.0 && <=0.0.15.0
+    , file-embed >=0.0.14.0 && <=0.0.15.0
    , filepath ==1.4.*
-    , generic-random >=1.2 && <1.5
+    , generic-random >=1.3 && <1.5
    , http-types ==0.12.*
    , iso8601-time ==0.1.*
-    , memory >=0.14 && <0.16
+    , memory ==0.15.*
    , mtl ==2.2.*
-    , network >=2.6 && <3.2
+    , network ==3.1.*
    , network-transport ==0.5.*
    , random >=1.1 && <1.3
-    , simple-logger ==0.0.4
-    , simplexmq
+    , simple-logger ==0.1.*
+    , simplexmq-v0
    , sqlite-simple ==0.4.*
-    , stm >=2.4 && <2.6
-    , template-haskell >=2.13 && <2.17
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
    , text ==1.2.*
-    , time >=1.8 && <1.10
+    , time ==1.9.*
    , transformers ==0.5.*
    , unliftio ==0.2.*
-    , unliftio-core >=0.1 && <0.3
+    , unliftio-core ==0.2.*
    , websockets ==0.12.*
    , x509 ==1.7.*
  default-language: Haskell2010
@@ -150,13 +151,13 @@ executable smp-agent
 executable smp-server
  main-is: Main.hs
  other-modules:
-      Paths_simplexmq
+      Paths_simplexmq_v0
  hs-source-dirs:
      apps/smp-server
  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
  build-depends:
-      QuickCheck >=2.11 && <2.15
-    , ansi-terminal >=0.8 && <0.12
+      QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
    , asn1-encoding ==0.9.*
    , asn1-types ==0.3.*
    , async ==2.2.*
@@ -165,34 +166,34 @@ executable smp-server
    , base64-bytestring >=1.0 && <1.3
    , bytestring ==0.10.*
    , composition ==1.0.*
-    , constraints >=0.10 && <0.14
-    , containers >=0.5 && <0.7
-    , cryptonite >=0.25 && <0.30
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
    , cryptostore ==0.2.*
    , direct-sqlite ==2.3.*
    , directory ==1.3.*
-    , file-embed >=0.0.10.0 && <=0.0.15.0
+    , file-embed >=0.0.14.0 && <=0.0.15.0
    , filepath ==1.4.*
-    , generic-random >=1.2 && <1.5
+    , generic-random >=1.3 && <1.5
    , http-types ==0.12.*
-    , ini >=0.3 && <0.5
+    , ini ==0.4.*
    , iso8601-time ==0.1.*
-    , memory >=0.14 && <0.16
+    , memory ==0.15.*
    , mtl ==2.2.*
-    , network >=2.6 && <3.2
+    , network ==3.1.*
    , network-transport ==0.5.*
-    , optparse-applicative >=0.14 && <0.17
+    , optparse-applicative >=0.15 && <0.17
    , random >=1.1 && <1.3
-    , simple-logger ==0.0.4
-    , simplexmq
+    , simple-logger ==0.1.*
+    , simplexmq-v0
    , sqlite-simple ==0.4.*
-    , stm >=2.4 && <2.6
-    , template-haskell >=2.13 && <2.17
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
    , text ==1.2.*
-    , time >=1.8 && <1.10
+    , time ==1.9.*
    , transformers ==0.5.*
    , unliftio ==0.2.*
-    , unliftio-core >=0.1 && <0.3
+    , unliftio-core ==0.2.*
    , websockets ==0.12.*
    , x509 ==1.7.*
  default-language: Haskell2010
@@ -209,14 +210,14 @@ test-suite smp-server-test
      ServerTests
      SMPAgentClient
      SMPClient
-      Paths_simplexmq
+      Paths_simplexmq_v0
  hs-source-dirs:
      tests
  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
  build-depends:
      HUnit ==1.6.*
-    , QuickCheck >=2.11 && <2.15
-    , ansi-terminal >=0.8 && <0.12
+    , QuickCheck ==2.14.*
+    , ansi-terminal >=0.10 && <0.12
    , asn1-encoding ==0.9.*
    , asn1-types ==0.3.*
    , async ==2.2.*
@@ -225,34 +226,34 @@ test-suite smp-server-test
    , base64-bytestring >=1.0 && <1.3
    , bytestring ==0.10.*
    , composition ==1.0.*
-    , constraints >=0.10 && <0.14
-    , containers >=0.5 && <0.7
-    , cryptonite >=0.25 && <0.30
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
    , direct-sqlite ==2.3.*
    , directory ==1.3.*
-    , file-embed >=0.0.10.0 && <=0.0.15.0
+    , file-embed >=0.0.14.0 && <=0.0.15.0
    , filepath ==1.4.*
-    , generic-random >=1.2 && <1.5
-    , hspec >=2.5 && <2.8
-    , hspec-core >=2.5 && <2.8
+    , generic-random >=1.3 && <1.5
+    , hspec ==2.7.*
+    , hspec-core ==2.7.*
    , http-types ==0.12.*
    , iso8601-time ==0.1.*
-    , memory >=0.14 && <0.16
+    , memory ==0.15.*
    , mtl ==2.2.*
-    , network >=2.6 && <3.2
+    , network ==3.1.*
    , network-transport ==0.5.*
    , random >=1.1 && <1.3
-    , simple-logger ==0.0.4
-    , simplexmq
+    , simple-logger ==0.1.*
+    , simplexmq-v0
    , sqlite-simple ==0.4.*
-    , stm >=2.4 && <2.6
-    , template-haskell >=2.13 && <2.17
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
    , text ==1.2.*
-    , time >=1.8 && <1.10
+    , time ==1.9.*
    , timeit ==2.0.*
    , transformers ==0.5.*
    , unliftio ==0.2.*
-    , unliftio-core >=0.1 && <0.3
+    , unliftio-core ==0.2.*
    , websockets ==0.12.*
    , x509 ==1.7.*
  default-language: Haskell2010
@@ -7,6 +7,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -55,6 +56,7 @@ module Simplex.Messaging.Agent
  )
 where

+import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple (logInfo, showText)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
@@ -84,7 +86,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (MsgBody, SenderPublicKey)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), currentSMPVersionStr, runTransportServer)
-import Simplex.Messaging.Util (bshow, stateTVar, tryError, unlessM)
+import Simplex.Messaging.Util (bshow, tryError, unlessM)
 import System.Random (randomR)
 import UnliftIO.Async (async, race_)
 import qualified UnliftIO.Exception as E
@@ -284,7 +286,7 @@ joinConn c connId (CRContact (ConnReqData _ (qUri :| _) encryptKey)) cInfo = do
  sendInvitation c qUri encryptKey cReq cInfo
  pure connId'

-activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m ()
+activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
 activateQueueJoining c connId sq verifyKey retryInterval =
  activateQueue c connId sq verifyKey retryInterval createReplyQueue
  where
@@ -333,33 +335,36 @@ subscribeConnection' c connId =
    SomeConn _ (DuplexConnection _ rq sq) -> do
      resumeMsgDelivery c connId sq
      case status (sq :: SndQueue) of
-        Confirmed -> do
+        Confirmed -> withVerifyKey sq $ \verifyKey -> do
          conf <- withStore (`getAcceptedConfirmation` connId)
          secureQueue c rq $ senderKey (conf :: AcceptedConfirmation)
          withStore $ \st -> setRcvQueueStatus st rq Secured
-          activateSecuredQueue rq sq
-        Secured -> activateSecuredQueue rq sq
+          activateSecuredQueue rq sq verifyKey
+        Secured -> withVerifyKey sq $ activateSecuredQueue rq sq
        Active -> subscribeQueue c rq connId
        _ -> throwError $ INTERNAL "unexpected queue status"
    SomeConn _ (SndConnection _ sq) -> do
      resumeMsgDelivery c connId sq
      case status (sq :: SndQueue) of
-        Confirmed -> activateQueueJoining c connId sq (verifyKey sq) =<< resumeInterval
+        Confirmed -> withVerifyKey sq $ \verifyKey ->
+          activateQueueJoining c connId sq verifyKey =<< resumeInterval
        Active -> throwError $ CONN SIMPLEX
        _ -> throwError $ INTERNAL "unexpected queue status"
    SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId
    SomeConn _ (ContactConnection _ rq) -> subscribeQueue c rq connId
  where
-    verifyKey :: SndQueue -> C.APublicVerifyKey
-    verifyKey = C.publicKey . signKey
-    activateSecuredQueue :: RcvQueue -> SndQueue -> m ()
-    activateSecuredQueue rq sq = do
-      activateQueueInitiating c connId sq (verifyKey sq) =<< resumeInterval
+    withVerifyKey :: SndQueue -> (C.PublicKey -> m ()) -> m ()
+    withVerifyKey sq action =
+      let err = throwError $ INTERNAL "missing signing key public counterpart"
+       in maybe err action . C.publicKey $ signKey sq
+    activateSecuredQueue :: RcvQueue -> SndQueue -> C.PublicKey -> m ()
+    activateSecuredQueue rq sq verifyKey = do
+      activateQueueInitiating c connId sq verifyKey =<< resumeInterval
      subscribeQueue c rq connId
    resumeInterval :: m RetryInterval
    resumeInterval = do
      r <- asks $ retryInterval . config
-      pure r {initialInterval = 5000000}
+      pure r {initialInterval = 5_000_000}

 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgBody -> m AgentMsgId
@@ -370,10 +375,10 @@ sendMessage' c connId msg =
    _ -> throwError $ CONN SIMPLEX
  where
    enqueueMessage :: SndQueue -> m AgentMsgId
-    enqueueMessage sq@SndQueue {server} = do
+    enqueueMessage sq = do
      resumeMsgDelivery c connId sq
      msgId <- storeSentMsg
-      queuePendingMsgs c connId server [msgId]
+      queuePendingMsgs c connId sq [msgId]
      pure $ unId msgId
      where
        storeSentMsg :: m InternalId
@@ -395,15 +400,16 @@ sendMessage' c connId msg =
            pure internalId

 resumeMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
-resumeMsgDelivery c connId SndQueue {server} = do
-  unlessM srvDelivering $
-    async (runSrvMsgDelivery c server)
-      >>= atomically . modifyTVar (srvMsgDeliveries c) . M.insert server
+resumeMsgDelivery c connId sq@SndQueue {server, sndId} = do
+  let qKey = (connId, server, sndId)
+  unlessM (queueDelivering qKey) $
+    async (runSmpQueueMsgDelivery c connId sq)
+      >>= atomically . modifyTVar (smpQueueMsgDeliveries c) . M.insert qKey
  unlessM connQueued $
    withStore (`getPendingMsgs` connId)
-      >>= queuePendingMsgs c connId server
+      >>= queuePendingMsgs c connId sq
  where
-    srvDelivering = isJust . M.lookup server <$> readTVarIO (srvMsgDeliveries c)
+    queueDelivering qKey = isJust . M.lookup qKey <$> readTVarIO (smpQueueMsgDeliveries c)
    connQueued =
      atomically $
        isJust
@@ -411,45 +417,45 @@ resumeMsgDelivery c connId SndQueue {server} = do
            (connMsgsQueued c)
            (\m -> (M.lookup connId m, M.insert connId True m))

-queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> SMPServer -> [InternalId] -> m ()
-queuePendingMsgs c connId server msgIds = atomically $ do
-  q <- getPendingMsgQ c server
-  mapM_ (writeTQueue q . PendingMsg connId) msgIds
+queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> [InternalId] -> m ()
+queuePendingMsgs c connId sq msgIds = atomically $ do
+  q <- getPendingMsgQ c connId sq
+  mapM_ (writeTQueue q) msgIds

-getPendingMsgQ :: AgentClient -> SMPServer -> STM (TQueue PendingMsg)
-getPendingMsgQ c srv = do
-  maybe newMsgQueue pure . M.lookup srv =<< readTVar (srvMsgQueues c)
+getPendingMsgQ :: AgentClient -> ConnId -> SndQueue -> STM (TQueue InternalId)
+getPendingMsgQ c connId SndQueue {server, sndId} = do
+  let qKey = (connId, server, sndId)
+  maybe (newMsgQueue qKey) pure . M.lookup qKey =<< readTVar (smpQueueMsgQueues c)
  where
-    newMsgQueue :: STM (TQueue PendingMsg)
-    newMsgQueue = do
+    newMsgQueue qKey = do
      mq <- newTQueue
-      modifyTVar (srvMsgQueues c) $ M.insert srv mq
+      modifyTVar (smpQueueMsgQueues c) $ M.insert qKey mq
      pure mq

-runSrvMsgDelivery :: forall m. AgentMonad m => AgentClient -> SMPServer -> m ()
-runSrvMsgDelivery c@AgentClient {subQ} srv = do
-  mq <- atomically $ getPendingMsgQ c srv
+runSmpQueueMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
+runSmpQueueMsgDelivery c@AgentClient {subQ} connId sq = do
+  mq <- atomically $ getPendingMsgQ c connId sq
  ri <- asks $ reconnectInterval . config
  forever $ do
-    PendingMsg {connId, msgId} <- atomically $ readTQueue mq
+    msgId <- atomically $ readTQueue mq
    let mId = unId msgId
    withStore (\st -> E.try $ getPendingMsgData st connId msgId) >>= \case
      Left (e :: E.SomeException) ->
-        notify connId $ MERR mId (INTERNAL $ show e)
-      Right (sq, msgBody) -> do
+        notify $ MERR mId (INTERNAL $ show e)
+      Right msgBody -> do
        withRetryInterval ri $ \loop -> do
          tryError (sendAgentMessage c sq msgBody) >>= \case
            Left e -> case e of
              SMP SMP.QUOTA -> loop
-              SMP {} -> notify connId $ MERR mId e
-              CMD {} -> notify connId $ MERR mId e
+              SMP {} -> notify $ MERR mId e
+              CMD {} -> notify $ MERR mId e
              _ -> loop
            Right () -> do
-              notify connId $ SENT mId
+              notify $ SENT mId
              withStore $ \st -> updateSndMsgStatus st connId msgId SndMsgSent
  where
-    notify :: ConnId -> ACommand 'Agent -> m ()
-    notify connId cmd = atomically $ writeTBQueue subQ ("", connId, cmd)
+    notify :: ACommand 'Agent -> m ()
+    notify cmd = atomically $ writeTBQueue subQ ("", connId, cmd)

 ackMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> AgentMsgId -> m ()
 ackMessage' c connId msgId = do
@@ -632,11 +638,11 @@ confirmQueue c sq senderKey cInfo = do
  sendConfirmation c sq senderKey cInfo
  withStore $ \st -> setSndQueueStatus st sq Confirmed

-activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m ()
+activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m ()
 activateQueueInitiating c connId sq verifyKey retryInterval =
  activateQueue c connId sq verifyKey retryInterval $ notifyConnected c connId

-activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m () -> m ()
+activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m () -> m ()
 activateQueue c connId sq verifyKey retryInterval afterActivation =
  getActivation c connId >>= \case
    Nothing -> async runActivation >>= addActivation c connId
@@ -647,27 +653,22 @@ activateQueue c connId sq verifyKey retryInterval afterActivation =
      sendHello c sq verifyKey retryInterval
      withStore $ \st -> setSndQueueStatus st sq Active
      removeActivation c connId
+      removeVerificationKey
      afterActivation
+    removeVerificationKey :: m ()
+    removeVerificationKey =
+      let safeSignKey = C.removePublicKey $ signKey sq
+       in withStore $ \st -> updateSignKey st sq safeSignKey

 notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m ()
 notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON)

 newSndQueue ::
-  (MonadUnliftIO m, MonadReader Env m) => SMPQueueUri -> C.APublicEncryptKey -> m (SndQueue, SenderPublicKey, C.APublicVerifyKey)
-newSndQueue qUri encryptKey =
-  asks (cmdSignAlg . config) >>= \case
-    C.SignAlg a -> newSndQueue_ a qUri encryptKey
-
-newSndQueue_ ::
-  (C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m, MonadReader Env m) =>
-  C.SAlgorithm a ->
-  SMPQueueUri ->
-  C.APublicEncryptKey ->
-  m (SndQueue, SenderPublicKey, C.APublicVerifyKey)
-newSndQueue_ a (SMPQueueUri smpServer senderId _) encryptKey = do
+  (MonadUnliftIO m, MonadReader Env m) => SMPQueueUri -> EncryptionKey -> m (SndQueue, SenderPublicKey, VerificationKey)
+newSndQueue (SMPQueueUri smpServer senderId _) encryptKey = do
  size <- asks $ rsaKeySize . config
-  (senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a
-  (verifyKey, signKey) <- liftIO $ C.generateSignatureKeyPair size C.SRSA
+  (senderKey, sndPrivateKey) <- liftIO $ C.generateKeyPair size
+  (verifyKey, signKey) <- liftIO $ C.generateKeyPair size
  let sndQueue =
        SndQueue
          { server = smpServer,
@@ -37,6 +37,7 @@ module Simplex.Messaging.Agent.Client
 where

 import Control.Concurrent.Async (Async, async, uninterruptibleCancel)
+import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
@@ -53,13 +54,15 @@ import qualified Data.Set as S
 import Data.Text.Encoding
 import Data.Time.Clock
 import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Agent.ExceptT ()
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgBody, QueueId, SenderPublicKey)
-import Simplex.Messaging.Util (bshow, liftEitherError, liftError, stateTVar)
+import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Util (bshow, liftEitherError, liftError)
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -73,8 +76,8 @@ data AgentClient = AgentClient
    subscrConns :: TVar (Map ConnId SMPServer),
    activations :: TVar (Map ConnId (Async ())), -- activations of send queues in progress
    connMsgsQueued :: TVar (Map ConnId Bool),
-    srvMsgQueues :: TVar (Map SMPServer (TQueue PendingMsg)),
-    srvMsgDeliveries :: TVar (Map SMPServer (Async ())),
+    smpQueueMsgQueues :: TVar (Map (ConnId, SMPServer, SMP.SenderId) (TQueue InternalId)),
+    smpQueueMsgDeliveries :: TVar (Map (ConnId, SMPServer, SMP.SenderId) (Async ())),
    reconnections :: TVar [Async ()],
    clientId :: Int,
    agentEnv :: Env,
@@ -85,20 +88,20 @@ data AgentClient = AgentClient
 newAgentClient :: Env -> STM AgentClient
 newAgentClient agentEnv = do
  let qSize = tbqSize $ config agentEnv
-  rcvQ <- newTBQueue $ fromIntegral qSize
-  subQ <- newTBQueue $ fromIntegral qSize
-  msgQ <- newTBQueue $ fromIntegral qSize
+  rcvQ <- newTBQueue qSize
+  subQ <- newTBQueue qSize
+  msgQ <- newTBQueue qSize
  smpClients <- newTVar M.empty
  subscrSrvrs <- newTVar M.empty
  subscrConns <- newTVar M.empty
  activations <- newTVar M.empty
  connMsgsQueued <- newTVar M.empty
-  srvMsgQueues <- newTVar M.empty
-  srvMsgDeliveries <- newTVar M.empty
+  smpQueueMsgQueues <- newTVar M.empty
+  smpQueueMsgDeliveries <- newTVar M.empty
  reconnections <- newTVar []
  clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
  lock <- newTMVar ()
-  return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, activations, connMsgsQueued, srvMsgQueues, srvMsgDeliveries, reconnections, clientId, agentEnv, smpSubscriber = undefined, lock}
+  return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, activations, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, clientId, agentEnv, smpSubscriber = undefined, lock}

 -- | Agent monad with MonadReader Env and MonadError AgentErrorType
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)
@@ -174,7 +177,7 @@ closeAgentClient c = liftIO $ do
  closeSMPServerClients c
  cancelActions $ activations c
  cancelActions $ reconnections c
-  cancelActions $ srvMsgDeliveries c
+  cancelActions $ smpQueueMsgDeliveries c

 closeSMPServerClients :: AgentClient -> IO ()
 closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ closeSMPClient
@@ -223,24 +226,14 @@ smpClientError = \case
  SMPTransportError e -> BROKER $ TRANSPORT e
  e -> INTERNAL $ show e

-newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri, C.APublicEncryptKey)
-newRcvQueue c srv =
-  asks (cmdSignAlg . config) >>= \case
-    C.SignAlg a -> newRcvQueue_ a c srv
-
-newRcvQueue_ ::
-  (C.SignatureAlgorithm a, C.AlgorithmI a, AgentMonad m) =>
-  C.SAlgorithm a ->
-  AgentClient ->
-  SMPServer ->
-  m (RcvQueue, SMPQueueUri, C.APublicEncryptKey)
-newRcvQueue_ a c srv = do
+newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri, EncryptionKey)
+newRcvQueue c srv = do
  size <- asks $ rsaKeySize . config
-  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a
+  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateKeyPair size
  logServer "-->" c srv "" "NEW"
  (rcvId, sId) <- withSMP c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey
  logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sId]
-  (encryptKey, decryptKey) <- liftIO $ C.generateEncryptionKeyPair size C.SRSA
+  (encryptKey, decryptKey) <- liftIO $ C.generateKeyPair size
  let rq =
        RcvQueue
          { server = srv,
@@ -309,7 +302,7 @@ sendConfirmation c sq@SndQueue {server, sndId} senderKey cInfo =
    mkConfirmation :: SMPClient -> m MsgBody
    mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey cInfo

-sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m ()
+sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> RetryInterval -> m ()
 sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey ri =
  withLogSMP_ c server sndId "SEND <HELLO> (retrying)" $ \smp -> do
    msg <- mkHello smp $ AckMode On
@@ -329,7 +322,7 @@ sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey ri =
            agentMessage = HELLO verifyKey ackMode
          }

-sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> C.APublicEncryptKey -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
+sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> EncryptionKey -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
 sendInvitation c SMPQueueUri {smpServer, senderId} encryptKey cReq connInfo = do
  withLogSMP_ c smpServer senderId "SEND <INV>" $ \smp -> do
    msg <- mkInvitation smp
@@ -377,15 +370,15 @@ encryptAndSign smp SndQueue {encryptKey, signKey} msg = do
  paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
  liftError cryptoError $ do
    enc <- C.encrypt encryptKey paddedSize msg
-    sig <- C.sign signKey enc
-    pure $ C.signatureBytes sig <> enc
+    C.Signature sig <- C.sign signKey enc
+    pure $ sig <> enc

 decryptAndVerify :: AgentMonad m => RcvQueue -> ByteString -> m ByteString
 decryptAndVerify RcvQueue {decryptKey, verifyKey} msg =
  verifyMessage verifyKey msg
    >>= liftError cryptoError . C.decrypt decryptKey

-encryptUnsigned :: AgentMonad m => SMPClient -> C.APublicEncryptKey -> ByteString -> m ByteString
+encryptUnsigned :: AgentMonad m => SMPClient -> EncryptionKey -> ByteString -> m ByteString
 encryptUnsigned smp encryptKey msg = do
  paddedSize <- asks $ (blockSize smp -) . reservedMsgSize
  size <- asks $ rsaKeySize . config
@@ -394,19 +387,15 @@ encryptUnsigned smp encryptKey msg = do
    let sig = B.replicate size ' '
    pure $ sig <> enc

-verifyMessage :: AgentMonad m => Maybe C.APublicVerifyKey -> ByteString -> m ByteString
+verifyMessage :: AgentMonad m => Maybe VerificationKey -> ByteString -> m ByteString
 verifyMessage verifyKey msg = do
-  sigSize <- asks $ rsaKeySize . config
-  let (s, enc) = B.splitAt sigSize msg
+  size <- asks $ rsaKeySize . config
+  let (sig, enc) = B.splitAt size msg
  case verifyKey of
    Nothing -> pure enc
-    Just k ->
-      case C.decodeSignature $ B.take (C.signatureSize k) s of
-        Left _ -> throwError $ AGENT A_SIGNATURE
-        Right sig ->
-          if C.verify k sig enc
-            then pure enc
-            else throwError $ AGENT A_SIGNATURE
+    Just k
+      | C.verify k (C.Signature sig) enc -> pure enc
+      | otherwise -> throwError $ AGENT A_SIGNATURE

 cryptoError :: C.CryptoError -> AgentErrorType
 cryptoError = \case
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

 module Simplex.Messaging.Agent.Env.SQLite where
@@ -15,7 +16,6 @@ import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client
-import qualified Simplex.Messaging.Crypto as C
 import System.Random (StdGen, newStdGen)
 import UnliftIO.STM

@@ -23,7 +23,6 @@ data AgentConfig = AgentConfig
  { tcpPort :: ServiceName,
    smpServers :: NonEmpty SMPServer,
    rsaKeySize :: Int,
-    cmdSignAlg :: C.SignAlg,
    connIdBytes :: Int,
    tbqSize :: Natural,
    dbFile :: FilePath,
@@ -34,7 +33,7 @@ data AgentConfig = AgentConfig
  }

 minute :: Int
-minute = 60000000
+minute = 60_000_000

 defaultAgentConfig :: AgentConfig
 defaultAgentConfig =
@@ -42,7 +41,6 @@ defaultAgentConfig =
    { tcpPort = "5224",
      smpServers = undefined,
      rsaKeySize = 2048 `div` 8,
-      cmdSignAlg = C.SignAlg C.SEd448,
      connIdBytes = 12,
      tbqSize = 16,
      dbFile = "smp-agent.db",
@@ -50,15 +48,15 @@ defaultAgentConfig =
      smpCfg = smpDefaultConfig,
      retryInterval =
        RetryInterval
-          { initialInterval = 1000000,
+          { initialInterval = 1_000_000,
            increaseAfter = minute,
            maxInterval = 10 * minute
          },
      reconnectInterval =
        RetryInterval
-          { initialInterval = 1000000,
-            increaseAfter = 10000000,
-            maxInterval = 10000000
+          { initialInterval = 1_000_000,
+            increaseAfter = 10_000_000,
+            maxInterval = 10_000_000
          }
    }

@@ -0,0 +1,22 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Simplex.Messaging.Agent.ExceptT where
+
+import Control.Monad.Except
+import Control.Monad.IO.Unlift
+import UnliftIO.Exception (Exception)
+import qualified UnliftIO.Exception as E
+
+newtype InternalException e = InternalException {unInternalException :: e}
+  deriving (Eq, Show)
+
+instance Exception e => Exception (InternalException e)
+
+instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
+  withRunInIO :: ((forall a. ExceptT e m a -> IO a) -> IO b) -> ExceptT e m b
+  withRunInIO exceptToIO =
+    withExceptT unInternalException . ExceptT . E.try $
+      withRunInIO $ \run ->
+        exceptToIO $ run . (either (E.throwIO . InternalException) return <=< runExceptT)
@@ -66,6 +66,10 @@ module Simplex.Messaging.Agent.Protocol
    MsgIntegrity (..),
    MsgErrorType (..),
    QueueStatus (..),
+    SignatureKey,
+    VerificationKey,
+    EncryptionKey,
+    DecryptionKey,
    ACorrId,
    AgentMsgId,

@@ -294,7 +298,7 @@ data SMPMessage
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents
 data AMessage where
  -- | the first message in the queue to validate it is secured
-  HELLO :: C.APublicVerifyKey -> AckMode -> AMessage
+  HELLO :: VerificationKey -> AckMode -> AMessage
  -- | reply queue information
  REPLY :: ConnectionRequest CMInvitation -> AMessage
  -- | agent envelope for the client message
@@ -311,7 +315,7 @@ parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
    smpMessageP = A.endOfLine *> smpClientMessageP <|> smpConfirmationP

    smpConfirmationP :: Parser SMPMessage
-    smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.strKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine)
+    smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.pubKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine)

    smpClientMessageP :: Parser SMPMessage
    smpClientMessageP =
@@ -326,7 +330,7 @@ parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE
 -- | Serialize SMP message.
 serializeSMPMessage :: SMPMessage -> ByteString
 serializeSMPMessage = \case
-  SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializeKey sKey) "" (serializeBinary cInfo) <> "\n"
+  SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializePubKey sKey) "" (serializeBinary cInfo) <> "\n"
  SMPMessage {senderMsgId, senderTimestamp, previousMsgHash, agentMessage} ->
    let header = messageHeader senderMsgId senderTimestamp previousMsgHash
        body = serializeAgentMessage agentMessage
@@ -343,7 +347,7 @@ agentMessageP =
    <|> "MSG " *> a_msg
    <|> "INV " *> a_inv
  where
-    hello = HELLO <$> C.strKeyP <*> ackMode
+    hello = HELLO <$> C.pubKeyP <*> ackMode
    reply = REPLY <$> connReqP'
    a_msg = A_MSG <$> binaryBodyP <* A.endOfLine
    a_inv = A_INV <$> connReqP' <* A.space <*> binaryBodyP <* A.endOfLine
@@ -359,7 +363,7 @@ smpServerP = SMPServer <$> server <*> optional port <*> optional kHash

 serializeAgentMessage :: AMessage -> ByteString
 serializeAgentMessage = \case
-  HELLO verifyKey ackMode -> "HELLO " <> C.serializeKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
+  HELLO verifyKey ackMode -> "HELLO " <> C.serializePubKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else ""
  REPLY cReq -> "REPLY " <> serializeConnReq' cReq
  A_MSG body -> "MSG " <> serializeBinary body <> "\n"
  A_INV cReq cInfo -> B.unwords ["INV", serializeConnReq' cReq, serializeBinary cInfo] <> "\n"
@@ -374,8 +378,8 @@ smpQueueUriP :: Parser SMPQueueUri
 smpQueueUriP =
  SMPQueueUri <$> smpServerUriP <* "/" <*> base64UriP <* "#" <*> pure reservedServerKey

-reservedServerKey :: C.APublicVerifyKey
-reservedServerKey = C.APublicVerifyKey C.SRSA (C.PublicKeyRSA $ R.PublicKey 1 0 0)
+reservedServerKey :: C.PublicKey
+reservedServerKey = C.PublicKey $ R.PublicKey 1 0 0

 serializeConnReq :: AConnectionRequest -> ByteString
 serializeConnReq (ACR _ cr) = serializeConnReq' cr
@@ -396,7 +400,7 @@ serializeConnReq' = \case
          CMContact -> "contact"
        queryStr = renderSimpleQuery True [("smp", queues), ("e2e", key)]
        queues = B.intercalate "," . map serializeSMPQueueUri $ L.toList crSmpQueues
-        key = C.serializeKeyUri crEncryptKey
+        key = C.serializePubKeyUri crEncryptKey

 connReqP' :: forall m. ConnectionModeI m => Parser (ConnectionRequest m)
 connReqP' = do
@@ -411,7 +415,7 @@ connReqP = do
  crMode <- "/" *> mode <* "#/?"
  query <- parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
  crSmpQueues <- paramP "smp" smpQueues query
-  crEncryptKey <- paramP "e2e" C.strKeyUriP query
+  crEncryptKey <- paramP "e2e" C.pubKeyUriP query
  let cReq = ConnReqData {crScheme, crSmpQueues, crEncryptKey}
  pure $ case crMode of
    CMInvitation -> ACR SCMInvitation $ CRInvitation cReq
@@ -498,7 +502,7 @@ newtype AckMode = AckMode OnOff deriving (Eq, Show)
 data SMPQueueUri = SMPQueueUri
  { smpServer :: SMPServer,
    senderId :: SMP.SenderId,
-    serverVerifyKey :: C.APublicVerifyKey
+    serverVerifyKey :: VerificationKey
  }
  deriving (Eq, Show)

@@ -522,7 +526,7 @@ deriving instance Show AConnectionRequest
 data ConnReqData = ConnReqData
  { crScheme :: ConnReqScheme,
    crSmpQueues :: L.NonEmpty SMPQueueUri,
-    crEncryptKey :: C.APublicEncryptKey
+    crEncryptKey :: EncryptionKey
  }
  deriving (Eq, Show)

@@ -532,6 +536,18 @@ data ConnReqScheme = CRSSimplex | CRSAppServer HostName (Maybe ServiceName)
 simplexChat :: ConnReqScheme
 simplexChat = CRSAppServer "simplex.chat" Nothing

+-- | Public key used to E2E encrypt SMP messages.
+type EncryptionKey = C.PublicKey
+
+-- | Private key used to E2E decrypt SMP messages.
+type DecryptionKey = C.SafePrivateKey
+
+-- | Private key used to sign SMP commands
+type SignatureKey = C.APrivateKey
+
+-- | Public key used by SMP server to authorize (verify) SMP commands.
+type VerificationKey = C.PublicKey
+
 data QueueDirection = SND | RCV deriving (Show)

 -- | SMP queue status.
@@ -622,7 +638,7 @@ data SMPAgentError
    A_PROHIBITED
  | -- | cannot RSA/AES-decrypt or parse decrypted header
    A_ENCRYPTION
-  | -- | invalid signature
+  | -- | invalid RSA signature
    A_SIGNATURE
  deriving (Eq, Generic, Read, Show, Exception)

@@ -804,7 +820,7 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
      return (corrId, connId, fullCmd)

    fromParty :: ACmd -> Either AgentErrorType (ACommand p)
-    fromParty (ACmd p cmd) = case testEquality party p of
+    fromParty (ACmd (p :: p1) cmd) = case testEquality party p of
      Just Refl -> Right cmd
      _ -> Left $ CMD PROHIBITED

@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -19,7 +18,6 @@ import Data.Kind (Type)
 import Data.Time (UTCTime)
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
-import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
  ( MsgBody,
    MsgId,
@@ -43,8 +41,9 @@ class Monad m => MonadAgentStore s m where
  upgradeRcvConnToDuplex :: s -> ConnId -> SndQueue -> m ()
  upgradeSndConnToDuplex :: s -> ConnId -> RcvQueue -> m ()
  setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m ()
-  setRcvQueueActive :: s -> RcvQueue -> C.APublicVerifyKey -> m ()
+  setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m ()
  setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m ()
+  updateSignKey :: s -> SndQueue -> SignatureKey -> m ()

  -- Confirmations
  createConfirmation :: s -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
@@ -64,7 +63,7 @@ class Monad m => MonadAgentStore s m where
  updateSndIds :: s -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash)
  createSndMsg :: s -> ConnId -> SndMsgData -> m ()
  updateSndMsgStatus :: s -> ConnId -> InternalId -> SndMsgStatus -> m ()
-  getPendingMsgData :: s -> ConnId -> InternalId -> m (SndQueue, MsgBody)
+  getPendingMsgData :: s -> ConnId -> InternalId -> m MsgBody
  getPendingMsgs :: s -> ConnId -> m [InternalId]
  getMsg :: s -> ConnId -> InternalId -> m Msg
  checkRcvMsg :: s -> ConnId -> InternalId -> m ()
@@ -78,8 +77,8 @@ data RcvQueue = RcvQueue
    rcvId :: SMP.RecipientId,
    rcvPrivateKey :: RecipientPrivateKey,
    sndId :: Maybe SMP.SenderId,
-    decryptKey :: C.APrivateDecryptKey,
-    verifyKey :: Maybe C.APublicVerifyKey,
+    decryptKey :: DecryptionKey,
+    verifyKey :: Maybe VerificationKey,
    status :: QueueStatus
  }
  deriving (Eq, Show)
@@ -89,8 +88,8 @@ data SndQueue = SndQueue
  { server :: SMPServer,
    sndId :: SMP.SenderId,
    sndPrivateKey :: SenderPrivateKey,
-    encryptKey :: C.APublicEncryptKey,
-    signKey :: C.APrivateSignKey,
+    encryptKey :: EncryptionKey,
+    signKey :: SignatureKey,
    status :: QueueStatus
  }
  deriving (Eq, Show)
@@ -7,6 +7,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -51,11 +52,10 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration)
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
-import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (blobFieldParser)
 import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util (bshow, liftIOEither, stateTVar)
+import Simplex.Messaging.Util (bshow, liftIOEither)
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (takeDirectory)
@@ -139,7 +139,7 @@ withConnection SQLiteStore {dbConnPool} =
    (atomically . writeTBQueue dbConnPool)

 withTransaction :: forall a. SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransaction st action = withConnection st $ loop 100 100000
+withTransaction st action = withConnection st $ loop 100 100_000
  where
    loop :: Int -> Int -> DB.Connection -> IO a
    loop t tLim db =
@@ -249,7 +249,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
        |]
        [":status" := status, ":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId]

-  setRcvQueueActive :: SQLiteStore -> RcvQueue -> C.APublicVerifyKey -> m ()
+  setRcvQueueActive :: SQLiteStore -> RcvQueue -> VerificationKey -> m ()
  setRcvQueueActive st RcvQueue {rcvId, server = SMPServer {host, port}} verifyKey =
    -- ? throw error if queue does not exist?
    liftIO . withTransaction st $ \db ->
@@ -280,6 +280,18 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
        |]
        [":status" := status, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]

+  updateSignKey :: SQLiteStore -> SndQueue -> SignatureKey -> m ()
+  updateSignKey st SndQueue {sndId, server = SMPServer {host, port}} signatureKey =
+    liftIO . withTransaction st $ \db ->
+      DB.executeNamed
+        db
+        [sql|
+          UPDATE snd_queues
+          SET sign_key = :sign_key
+          WHERE host = :host AND port = :port AND snd_id = :snd_id;
+        |]
+        [":sign_key" := signatureKey, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId]
+
  createConfirmation :: SQLiteStore -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId
  createConfirmation st gVar NewConfirmation {connId, senderKey, senderConnInfo} =
    liftIOEither . withTransaction st $ \db ->
@@ -449,29 +461,23 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
          ":snd_status" := msgStatus
        ]

-  getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (SndQueue, MsgBody)
+  getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m MsgBody
  getPendingMsgData st connId msgId =
-    liftIOEither . withTransaction st $ \db -> runExceptT $ do
-      sq <- ExceptT $ sndQueue <$> getSndQueueByConnAlias_ db connId
-      msgBody <-
-        ExceptT $
-          sndMsgData
-            <$> DB.query
-              db
-              [sql|
-                SELECT m.msg_body
-                FROM messages m
-                JOIN snd_messages s ON s.conn_alias = m.conn_alias AND s.internal_id = m.internal_id
-                WHERE m.conn_alias = ? AND m.internal_id = ?
-              |]
-              (connId, msgId)
-      pure (sq, msgBody)
+    liftIOEither . withTransaction st $ \db ->
+      sndMsgData
+        <$> DB.query
+          db
+          [sql|
+            SELECT m.msg_body
+            FROM messages m
+            JOIN snd_messages s ON s.conn_alias = m.conn_alias AND s.internal_id = m.internal_id
+            WHERE m.conn_alias = ? AND m.internal_id = ?
+          |]
+          (connId, msgId)
    where
      sndMsgData :: [Only MsgBody] -> Either StoreError MsgBody
      sndMsgData [Only msgBody] = Right msgBody
      sndMsgData _ = Left SEMsgNotFound
-      sndQueue :: Maybe SndQueue -> Either StoreError SndQueue
-      sndQueue = maybe (Left SEConnNotFound) Right

  getPendingMsgs :: SQLiteStore -> ConnId -> m [InternalId]
  getPendingMsgs st connId =
@@ -4,6 +4,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -29,9 +30,7 @@ module Simplex.Messaging.Client
    -- * SMP protocol command functions
    createSMPQueue,
    subscribeSMPQueue,
-    subscribeSMPQueueNotifications,
    secureSMPQueue,
-    enableSMPQueueNotifications,
    sendSMPMessage,
    ackSMPMessage,
    suspendSMPQueue,
@@ -65,7 +64,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport (ATransport (..), TCP, THandle (..), TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
 import Simplex.Messaging.Transport.WebSockets (WS)
-import Simplex.Messaging.Util (bshow, liftError, raceAny_, stateTVar)
+import Simplex.Messaging.Util (bshow, liftError, raceAny_)
 import System.Timeout (timeout)

 -- | 'SMPClient' is a handle used to send commands to a specific SMP server.
@@ -81,7 +80,7 @@ data SMPClient = SMPClient
    tcpTimeout :: Int,
    clientCorrId :: TVar Natural,
    sentCommands :: TVar (Map CorrId Request),
-    sndQ :: TBQueue SentRawTransmission,
+    sndQ :: TBQueue SignedRawTransmission,
    rcvQ :: TBQueue SignedTransmissionOrError,
    msgQ :: TBQueue SMPServerTransmission,
    blockSize :: Int
@@ -114,8 +113,8 @@ smpDefaultConfig =
  SMPClientConfig
    { qSize = 16,
      defaultTransport = ("5223", transport @TCP),
-      tcpTimeout = 4000000,
-      smpPing = 30000000,
+      tcpTimeout = 4_000_000,
+      smpPing = 30_000_000,
      smpBlockSize = Just 8192,
      smpCommandSize = 256
    }
@@ -141,8 +140,8 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
      connected <- newTVar False
      clientCorrId <- newTVar 0
      sentCommands <- newTVar M.empty
-      sndQ <- newTBQueue $ fromIntegral qSize
-      rcvQ <- newTBQueue $ fromIntegral qSize
+      sndQ <- newTBQueue qSize
+      rcvQ <- newTBQueue qSize
      return
        SMPClient
          { action = undefined,
@@ -264,7 +263,7 @@ createSMPQueue ::
 createSMPQueue c rpKey rKey =
  -- TODO add signing this request too - requires changes in the server
  sendSMPCommand c (Just rpKey) "" (Cmd SRecipient $ NEW rKey) >>= \case
-    Cmd _ (IDS rId sId) -> pure (rId, sId)
+    Cmd _ (IDS rId sId) -> return (rId, sId)
    _ -> throwE SMPUnexpectedResponse

 -- | Subscribe to the SMP queue.
@@ -278,27 +277,12 @@ subscribeSMPQueue c@SMPClient {smpServer, msgQ} rpKey rId =
      lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
    _ -> throwE SMPUnexpectedResponse

-- | Subscribe to the SMP queue notifications.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue-notifications
-subscribeSMPQueueNotifications :: SMPClient -> NotifierPrivateKey -> NotifierId -> ExceptT SMPClientError IO ()
-subscribeSMPQueueNotifications = okSMPCommand $ Cmd SNotifier NSUB
-
 -- | Secure the SMP queue by adding a sender public key.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#secure-queue-command
 secureSMPQueue :: SMPClient -> RecipientPrivateKey -> RecipientId -> SenderPublicKey -> ExceptT SMPClientError IO ()
 secureSMPQueue c rpKey rId senderKey = okSMPCommand (Cmd SRecipient $ KEY senderKey) c rpKey rId

-- | Enable notifications for the queue for push notifications server.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
-enableSMPQueueNotifications :: SMPClient -> RecipientPrivateKey -> RecipientId -> NotifierPublicKey -> ExceptT SMPClientError IO NotifierId
-enableSMPQueueNotifications c rpKey rId notifierKey =
-  sendSMPCommand c (Just rpKey) rId (Cmd SRecipient $ NKEY notifierKey) >>= \case
-    Cmd _ (NID nId) -> pure nId
-    _ -> throwE SMPUnexpectedResponse
-
 -- | Send SMP message.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message
@@ -332,14 +316,14 @@ suspendSMPQueue = okSMPCommand $ Cmd SRecipient OFF
 deleteSMPQueue :: SMPClient -> RecipientPrivateKey -> QueueId -> ExceptT SMPClientError IO ()
 deleteSMPQueue = okSMPCommand $ Cmd SRecipient DEL

-okSMPCommand :: Cmd -> SMPClient -> C.APrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
+okSMPCommand :: Cmd -> SMPClient -> C.SafePrivateKey -> QueueId -> ExceptT SMPClientError IO ()
 okSMPCommand cmd c pKey qId =
  sendSMPCommand c (Just pKey) qId cmd >>= \case
    Cmd _ OK -> return ()
    _ -> throwE SMPUnexpectedResponse

 -- | Send any SMP command ('Cmd' type).
-sendSMPCommand :: SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd
+sendSMPCommand :: SMPClient -> Maybe C.SafePrivateKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd
 sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId cmd = do
  corrId <- lift_ getNextCorrId
  t <- signTransmission $ serializeTransmission (corrId, qId, cmd)
@@ -353,20 +337,20 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId
      i <- stateTVar clientCorrId $ \i -> (i, i + 1)
      pure . CorrId $ bshow i

-    signTransmission :: ByteString -> ExceptT SMPClientError IO SentRawTransmission
+    signTransmission :: ByteString -> ExceptT SMPClientError IO SignedRawTransmission
    signTransmission t = case pKey of
-      Nothing -> return (Nothing, t)
+      Nothing -> return ("", t)
      Just pk -> do
        sig <- liftError SMPSignatureError $ C.sign pk t
-        return (Just sig, t)
+        return (sig, t)

    -- two separate "atomically" needed to avoid blocking
-    sendRecv :: CorrId -> SentRawTransmission -> IO Response
+    sendRecv :: CorrId -> SignedRawTransmission -> IO Response
    sendRecv corrId t = atomically (send corrId t) >>= withTimeout . atomically . takeTMVar
      where
        withTimeout a = fromMaybe (Left SMPResponseTimeout) <$> timeout tcpTimeout a

-    send :: CorrId -> SentRawTransmission -> STM (TMVar Response)
+    send :: CorrId -> SignedRawTransmission -> STM (TMVar Response)
    send corrId t = do
      r <- newEmptyTMVar
      modifyTVar sentCommands . M.insert corrId $ Request qId r
@@ -34,19 +34,15 @@ module Simplex.Messaging.Protocol
    SignedTransmission,
    SignedTransmissionOrError,
    RawTransmission,
-    SentRawTransmission,
    SignedRawTransmission,
    CorrId (..),
    QueueId,
    RecipientId,
    SenderId,
-    NotifierId,
    RecipientPrivateKey,
    RecipientPublicKey,
    SenderPrivateKey,
    SenderPublicKey,
-    NotifierPrivateKey,
-    NotifierPublicKey,
    Encoded,
    MsgId,
    MsgBody,
@@ -77,7 +73,6 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Kind
-import Data.Maybe (isNothing)
 import Data.String
 import Data.Time.Clock
 import Data.Time.ISO8601
@@ -90,7 +85,7 @@ import Simplex.Messaging.Util
 import Test.QuickCheck (Arbitrary (..))

 -- | SMP protocol participants.
-data Party = Broker | Recipient | Sender | Notifier
+data Party = Broker | Recipient | Sender
  deriving (Show)

 -- | Singleton types for SMP protocol participants.
@@ -98,7 +93,6 @@ data SParty :: Party -> Type where
  SBroker :: SParty Broker
  SRecipient :: SParty Recipient
  SSender :: SParty Sender
-  SNotifier :: SParty Notifier

 deriving instance Show (SParty a)

@@ -111,21 +105,18 @@ deriving instance Show Cmd
 type Transmission = (CorrId, QueueId, Cmd)

 -- | SMP transmission with signature.
-type SignedTransmission = (Maybe C.ASignature, Transmission)
+type SignedTransmission = (C.Signature, Transmission)

 type TransmissionOrError = (CorrId, QueueId, Either ErrorType Cmd)

 -- | signed parsed transmission, with parsing error.
-type SignedTransmissionOrError = (Maybe C.ASignature, TransmissionOrError)
+type SignedTransmissionOrError = (C.Signature, TransmissionOrError)

 -- | unparsed SMP transmission with signature.
 type RawTransmission = (ByteString, ByteString, ByteString, ByteString)

-- | unparsed sent SMP transmission with signature.
-type SignedRawTransmission = (Maybe C.ASignature, ByteString, ByteString, ByteString)
-
-- | unparsed sent SMP transmission with signature.
-type SentRawTransmission = (Maybe C.ASignature, ByteString)
+-- | unparsed SMP transmission with signature.
+type SignedRawTransmission = (C.Signature, ByteString)

 -- | SMP queue ID for the recipient.
 type RecipientId = QueueId
@@ -133,9 +124,6 @@ type RecipientId = QueueId
 -- | SMP queue ID for the sender.
 type SenderId = QueueId

-- | SMP queue ID for notifications.
-type NotifierId = QueueId
-
 -- | SMP queue ID on the server.
 type QueueId = Encoded

@@ -145,20 +133,15 @@ data Command (a :: Party) where
  NEW :: RecipientPublicKey -> Command Recipient
  SUB :: Command Recipient
  KEY :: SenderPublicKey -> Command Recipient
-  NKEY :: NotifierPublicKey -> Command Recipient
  ACK :: Command Recipient
  OFF :: Command Recipient
  DEL :: Command Recipient
  -- SMP sender commands
  SEND :: MsgBody -> Command Sender
  PING :: Command Sender
-  -- SMP notification subscriber commands
-  NSUB :: Command Notifier
  -- SMP broker commands (responses, messages, notifications)
  IDS :: RecipientId -> SenderId -> Command Broker
  MSG :: MsgId -> UTCTime -> MsgBody -> Command Broker
-  NID :: NotifierId -> Command Broker
-  NMSG :: Command Broker
  END :: Command Broker
  OK :: Command Broker
  ERR :: ErrorType -> Command Broker
@@ -182,24 +165,18 @@ instance IsString CorrId where
 -- | Recipient's private key used by the recipient to authorize (sign) SMP commands.
 --
 -- Only used by SMP agent, kept here so its definition is close to respective public key.
-type RecipientPrivateKey = C.APrivateSignKey
+type RecipientPrivateKey = C.SafePrivateKey

 -- | Recipient's public key used by SMP server to verify authorization of SMP commands.
-type RecipientPublicKey = C.APublicVerifyKey
+type RecipientPublicKey = C.PublicKey

 -- | Sender's private key used by the recipient to authorize (sign) SMP commands.
 --
 -- Only used by SMP agent, kept here so its definition is close to respective public key.
-type SenderPrivateKey = C.APrivateSignKey
+type SenderPrivateKey = C.SafePrivateKey

 -- | Sender's public key used by SMP server to verify authorization of SMP commands.
-type SenderPublicKey = C.APublicVerifyKey
-
-- | Private key used by push notifications server to authorize (sign) LSTN command.
-type NotifierPrivateKey = C.APrivateSignKey
-
-- | Public key used by SMP server to verify authorization of LSTN command sent by push notifications server.
-type NotifierPublicKey = C.APublicVerifyKey
+type SenderPublicKey = C.PublicKey

 -- | SMP message server ID.
 type MsgId = Encoded
@@ -248,11 +225,11 @@ instance Arbitrary CommandError where arbitrary = genericArbitraryU
 -- | SMP transmission parser.
 transmissionP :: Parser RawTransmission
 transmissionP = do
-  sig <- segment
+  signature <- segment
  corrId <- segment
  queueId <- segment
  command <- A.takeByteString
-  return (sig, corrId, queueId, command)
+  return (signature, corrId, queueId, command)
  where
    segment = A.takeTill (== ' ') <* " "

@@ -263,26 +240,20 @@ commandP =
    <|> "IDS " *> idsResp
    <|> "SUB" $> Cmd SRecipient SUB
    <|> "KEY " *> keyCmd
-    <|> "NKEY " *> nKeyCmd
-    <|> "NID " *> nIdsResp
    <|> "ACK" $> Cmd SRecipient ACK
    <|> "OFF" $> Cmd SRecipient OFF
    <|> "DEL" $> Cmd SRecipient DEL
    <|> "SEND " *> sendCmd
    <|> "PING" $> Cmd SSender PING
-    <|> "NSUB" $> Cmd SNotifier NSUB
    <|> "MSG " *> message
-    <|> "NMSG" $> Cmd SBroker NMSG
    <|> "END" $> Cmd SBroker END
    <|> "OK" $> Cmd SBroker OK
    <|> "ERR " *> serverError
    <|> "PONG" $> Cmd SBroker PONG
  where
-    newCmd = Cmd SRecipient . NEW <$> C.strKeyP
+    newCmd = Cmd SRecipient . NEW <$> C.pubKeyP
    idsResp = Cmd SBroker <$> (IDS <$> (base64P <* A.space) <*> base64P)
-    nIdsResp = Cmd SBroker . NID <$> base64P
-    keyCmd = Cmd SRecipient . KEY <$> C.strKeyP
-    nKeyCmd = Cmd SRecipient . NKEY <$> C.strKeyP
+    keyCmd = Cmd SRecipient . KEY <$> C.pubKeyP
    sendCmd = do
      size <- A.decimal <* A.space
      Cmd SSender . SEND <$> A.take size <* A.space
@@ -302,25 +273,16 @@ parseCommand = parse (commandP <* " " <* A.takeByteString) $ CMD SYNTAX
 -- | Serialize SMP command.
 serializeCommand :: Cmd -> ByteString
 serializeCommand = \case
-  Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializeKey rKey
-  Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializeKey sKey
-  Cmd SRecipient (NKEY nKey) -> "NKEY " <> C.serializeKey nKey
-  Cmd SRecipient SUB -> "SUB"
-  Cmd SRecipient ACK -> "ACK"
-  Cmd SRecipient OFF -> "OFF"
-  Cmd SRecipient DEL -> "DEL"
+  Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializePubKey rKey
+  Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializePubKey sKey
+  Cmd SRecipient cmd -> bshow cmd
  Cmd SSender (SEND msgBody) -> "SEND " <> serializeMsg msgBody
  Cmd SSender PING -> "PING"
-  Cmd SNotifier NSUB -> "NSUB"
  Cmd SBroker (MSG msgId ts msgBody) ->
    B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts, serializeMsg msgBody]
  Cmd SBroker (IDS rId sId) -> B.unwords ["IDS", encode rId, encode sId]
-  Cmd SBroker (NID nId) -> "NID " <> encode nId
  Cmd SBroker (ERR err) -> "ERR " <> serializeErrorType err
-  Cmd SBroker NMSG -> "NMSG"
-  Cmd SBroker END -> "END"
-  Cmd SBroker OK -> "OK"
-  Cmd SBroker PONG -> "PONG"
+  Cmd SBroker resp -> bshow resp
  where
    serializeMsg msgBody = bshow (B.length msgBody) <> " " <> msgBody <> " "

@@ -333,9 +295,9 @@ serializeErrorType :: ErrorType -> ByteString
 serializeErrorType = bshow

 -- | Send signed SMP transmission to TCP transport.
-tPut :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
-tPut th (sig, t) =
-  tPutEncrypted th $ C.serializeSignature sig <> " " <> t <> " "
+tPut :: Transport c => THandle c -> SignedRawTransmission -> IO (Either TransportError ())
+tPut th (C.Signature sig, t) =
+  tPutEncrypted th $ encode sig <> " " <> t <> " "

 -- | Serialize SMP transmission.
 serializeTransmission :: Transmission -> ByteString
@@ -367,23 +329,28 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
  where
    decodeParseValidate :: Either TransportError RawTransmission -> m SignedTransmissionOrError
    decodeParseValidate = \case
-      Right (sig, corrId, queueId, command) ->
-        let decodedTransmission = liftM2 (,corrId,,command) (C.decodeSignature =<< decode sig) (decode queueId)
+      Right (signature, corrId, queueId, command) ->
+        let decodedTransmission = liftM2 (,corrId,,command) (validSig =<< decode signature) (decode queueId)
         in either (const $ tError corrId) tParseValidate decodedTransmission
      Left _ -> tError ""

-    tError :: ByteString -> m SignedTransmissionOrError
-    tError corrId = return (Nothing, (CorrId corrId, "", Left BLOCK))
+    validSig :: ByteString -> Either String ByteString
+    validSig sig
+      | B.null sig || C.validKeySize (B.length sig) = Right sig
+      | otherwise = Left "invalid signature size"

-    tParseValidate :: SignedRawTransmission -> m SignedTransmissionOrError
+    tError :: ByteString -> m SignedTransmissionOrError
+    tError corrId = return (C.Signature "", (CorrId corrId, "", Left BLOCK))
+
+    tParseValidate :: RawTransmission -> m SignedTransmissionOrError
    tParseValidate t@(sig, corrId, queueId, command) = do
      let cmd = parseCommand command >>= fromParty >>= tCredentials t
-      return (sig, (CorrId corrId, queueId, cmd))
+      return (C.Signature sig, (CorrId corrId, queueId, cmd))

-    tCredentials :: SignedRawTransmission -> Cmd -> Either ErrorType Cmd
-    tCredentials (sig, _, queueId, _) cmd = case cmd of
+    tCredentials :: RawTransmission -> Cmd -> Either ErrorType Cmd
+    tCredentials (signature, _, queueId, _) cmd = case cmd of
      -- IDS response must not have queue ID
-      Cmd SBroker IDS {} -> Right cmd
+      Cmd SBroker (IDS _ _) -> Right cmd
      -- ERR response does not always have queue ID
      Cmd SBroker (ERR _) -> Right cmd
      -- PONG response must not have queue ID
@@ -395,8 +362,8 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
        | B.null queueId -> Left $ CMD NO_QUEUE
        | otherwise -> Right cmd
      -- NEW must have signature but NOT queue ID
-      Cmd SRecipient NEW {}
-        | isNothing sig -> Left $ CMD NO_AUTH
+      Cmd SRecipient (NEW _)
+        | B.null signature -> Left $ CMD NO_AUTH
        | not (B.null queueId) -> Left $ CMD HAS_AUTH
        | otherwise -> Right cmd
      -- SEND must have queue ID, signature is not always required
@@ -405,9 +372,9 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
        | otherwise -> Right cmd
      -- PING must not have queue ID or signature
      Cmd SSender PING
-        | isNothing sig && B.null queueId -> Right cmd
+        | B.null queueId && B.null signature -> Right cmd
        | otherwise -> Left $ CMD HAS_AUTH
      -- other client commands must have both signature and queue ID
-      Cmd _ _
-        | isNothing sig || B.null queueId -> Left $ CMD NO_AUTH
+      Cmd SRecipient _
+        | B.null signature || B.null queueId -> Left $ CMD NO_AUTH
        | otherwise -> Right cmd
@@ -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
@@ -34,9 +35,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import qualified Data.Map.Strict as M
-import Data.Maybe (isNothing)
 import Data.Time.Clock
-import Data.Type.Equality
 import Network.Socket (ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
@@ -73,38 +72,32 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do
    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
-        )
+      raceAny_ (serverThread s : map runServer transports)
        `finally` withLog closeStoreLog

    runServer :: (MonadUnliftIO m', MonadReader Env m') => (ServiceName, ATransport) -> m' ()
    runServer (tcpPort, ATransport t) = runTransportServer started tcpPort (runClient t)

-    serverThread ::
-      forall m' s.
-      MonadUnliftIO m' =>
-      Server ->
-      (Server -> TBQueue (QueueId, Client)) ->
-      (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 >>= mapM_ unsub
+    serverThread :: MonadUnliftIO m' => Server -> m' ()
+    serverThread Server {subscribedQ, subscribers} = forever $ do
+      atomically updateSubscribers >>= \case
+        Just (rId, Client {rcvQ}) ->
+          void . forkIO . atomically $
+            writeTBQueue rcvQ (CorrId "", rId, Cmd SBroker END)
+        _ -> pure ()
      where
-        updateSubscribers :: STM (Maybe s)
+        updateSubscribers :: STM (Maybe (RecipientId, Client))
        updateSubscribers = do
-          (qId, clnt) <- readTBQueue $ subQ s
-          serverSubs <- readTVar $ subs s
-          writeTVar (subs s) $ M.insert qId clnt serverSubs
-          join <$> mapM (endPreviousSubscriptions qId) (M.lookup qId serverSubs)
-        endPreviousSubscriptions :: QueueId -> Client -> STM (Maybe s)
-        endPreviousSubscriptions qId c = do
-          writeTBQueue (rcvQ c) (CorrId B.empty, qId, Cmd SBroker END)
-          stateTVar (clientSubs c) $ \ss -> (M.lookup qId ss, M.delete qId ss)
+          (rId, c) <- readTBQueue subscribedQ
+          stateTVar subscribers (\cs -> (M.lookup rId cs, M.insert rId c cs)) >>= \case
+            Just c' -> clientToBeNotified rId c c'
+            _ -> pure Nothing
+        clientToBeNotified :: RecipientId -> Client -> Client -> STM (Maybe (RecipientId, Client))
+        clientToBeNotified rId c c'@Client {connected}
+          | clientId c /= clientId c' = do
+            yes <- readTVar connected
+            pure $ if yes then Just (rId, c') else Nothing
+          | otherwise = pure Nothing

 runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
 runClient _ h = do
@@ -117,14 +110,23 @@ runClient _ h = do
 runClientTransport :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> m ()
 runClientTransport th = do
  q <- asks $ tbqSize . config
-  c <- atomically $ newClient q
  s <- asks server
+  c <- atomically $ newClient s q
  raceAny_ [send th c, client c s, receive th c]
-    `finally` cancelSubscribers c
+    `finally` clientDisconnected c

-cancelSubscribers :: MonadUnliftIO m => Client -> m ()
-cancelSubscribers Client {subscriptions} =
-  readTVarIO subscriptions >>= mapM_ cancelSub
+clientDisconnected :: (MonadUnliftIO m, MonadReader Env m) => Client -> m ()
+clientDisconnected c@Client {subscriptions, connected} = do
+  atomically $ writeTVar connected False
+  subs <- readTVarIO subscriptions
+  mapM_ cancelSub subs
+  cs <- asks $ subscribers . server
+  atomically . mapM_ (modifyTVar cs . M.update deleteCurrentClient) $ M.keys subs
+  where
+    deleteCurrentClient :: Client -> Maybe Client
+    deleteCurrentClient c'
+      | clientId c == clientId c' = Nothing
+      | otherwise = Just c'

 cancelSub :: MonadUnliftIO m => Sub -> m ()
 cancelSub = \case
@@ -142,119 +144,104 @@ receive h Client {rcvQ} = forever $ do
 send :: (Transport c, MonadUnliftIO m) => THandle c -> Client -> m ()
 send h Client {sndQ} = forever $ do
  t <- atomically $ readTBQueue sndQ
-  liftIO $ tPut h (Nothing, serializeTransmission t)
+  liftIO $ tPut h ("", serializeTransmission t)

 mkResp :: CorrId -> QueueId -> Command 'Broker -> Transmission
 mkResp corrId queueId command = (corrId, queueId, Cmd SBroker command)

 verifyTransmission :: forall m. (MonadUnliftIO m, MonadReader Env m) => SignedTransmission -> m Transmission
-verifyTransmission (sig_, t@(corrId, queueId, cmd)) = do
+verifyTransmission (sig, t@(corrId, queueId, cmd)) = do
  (corrId,queueId,) <$> case cmd of
    Cmd SBroker _ -> return $ smpErr INTERNAL -- it can only be client command, because `fromClient` was used
    Cmd SRecipient (NEW k) -> pure $ verifySignature k
    Cmd SRecipient _ -> verifyCmd SRecipient $ verifySignature . recipientKey
-    Cmd SSender (SEND _) -> verifyCmd SSender $ verifyMaybe . senderKey
+    Cmd SSender (SEND _) -> verifyCmd SSender $ verifySend sig . senderKey
    Cmd SSender PING -> return cmd
-    Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe . fmap snd . notifier
  where
    verifyCmd :: SParty p -> (QueueRec -> Cmd) -> m Cmd
    verifyCmd party f = do
      st <- asks queueStore
      q <- atomically $ getQueue st party queueId
-      pure $ either (const $ dummyVerify_ sig_ authErr) f q
-    verifyMaybe :: Maybe C.APublicVerifyKey -> Cmd
-    verifyMaybe (Just k) = verifySignature k
-    verifyMaybe _ = maybe cmd (const authErr) sig_
-    verifySignature :: C.APublicVerifyKey -> Cmd
-    verifySignature key = case sig_ of
-      Just s -> if verify key s then cmd else authErr
-      _ -> authErr
-    verify :: C.APublicVerifyKey -> C.ASignature -> Bool
-    verify (C.APublicVerifyKey a k) sig@(C.ASignature a' s) =
-      case (testEquality a a', C.signatureSize k == C.signatureSize s) of
-        (Just Refl, True) -> cryptoVerify k s
-        _ -> dummyVerify sig False
-    cryptoVerify :: C.SignatureAlgorithm a => C.PublicKey a -> C.Signature a -> Bool
-    cryptoVerify k s = C.verify' k s (serializeTransmission t)
-    dummyVerify_ :: Maybe C.ASignature -> a -> a
-    dummyVerify_ = \case
-      Just s -> dummyVerify s
-      _ -> id
-    dummyVerify :: C.ASignature -> a -> a
-    dummyVerify (C.ASignature _ s) = seq $ cryptoVerify (dummyPublicKey s) s
+      pure $ either (const $ dummyVerify authErr) f q
+    verifySend :: C.Signature -> Maybe SenderPublicKey -> Cmd
+    verifySend "" = maybe cmd (const authErr)
+    verifySend _ = maybe authErr verifySignature
+    verifySignature :: C.PublicKey -> Cmd
+    verifySignature key = if verify key then cmd else authErr
+    verify key
+      | C.publicKeySize key == sigLen = cryptoVerify key
+      | otherwise = dummyVerify False
+    cryptoVerify key = C.verify key sig (serializeTransmission t)
    smpErr = Cmd SBroker . ERR
    authErr = smpErr AUTH
+    dummyVerify :: a -> a
+    dummyVerify = seq $
+      cryptoVerify $ case sigLen of
+        128 -> dummyKey128
+        256 -> dummyKey256
+        384 -> dummyKey384
+        512 -> dummyKey512
+        _ -> dummyKey256
+    sigLen = B.length $ C.unSignature sig

 -- These dummy keys are used with `dummyVerify` function to mitigate timing attacks
 -- by having the same time of the response whether a queue exists or nor, for all valid key/signature sizes
-dummyPublicKey :: C.Signature a -> C.PublicKey a
-dummyPublicKey = \case
-  C.SignatureRSA s' -> case B.length s' of
-    128 -> dummyKey128
-    256 -> dummyKey256
-    384 -> dummyKey384
-    512 -> dummyKey512
-    _ -> dummyKey256
-  C.SignatureEd25519 _ -> dummyKeyEd25519
-  C.SignatureEd448 _ -> dummyKeyEd448
-
-dummyKeyEd25519 :: C.PublicKey 'C.Ed25519
-dummyKeyEd25519 = "MCowBQYDK2VwAyEA139Oqs4QgpqbAmB0o7rZf6T19ryl7E65k4AYe0kE3Qs="
-
-dummyKeyEd448 :: C.PublicKey 'C.Ed448
-dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"
-
-dummyKey128 :: C.PublicKey 'C.RSA
+dummyKey128 :: C.PublicKey
 dummyKey128 = "MIIBIDANBgkqhkiG9w0BAQEFAAOCAQ0AMIIBCAKBgQC2oeA7s4roXN5K2N6022I1/2CTeMKjWH0m00bSZWa4N8LDKeFcShh8YUxZea5giAveViTRNOOVLgcuXbKvR3u24szN04xP0+KnYUuUUIIoT3YSjX0IlomhDhhSyup4BmA0gAZ+D1OaIKZFX6J8yQ1Lr/JGLEfSRsBjw8l+4hs9OwKBgQDKA+YlZvGb3BcpDwKmatiCXN7ZRDWkjXbj8VAW5zV95tSRCCVN48hrFM1H4Ju2QMMUc6kPUVX+eW4ZjdCl5blIqIHMcTmsdcmsDDCg3PjUNrwc6bv/1TcirbAKcmnKt9iurIt6eerxSO7TZUXXMUVsi7eRwb/RUNhpCrpJ/hpIOw=="

-dummyKey256 :: C.PublicKey 'C.RSA
+dummyKey256 :: C.PublicKey
 dummyKey256 = "MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAxwmTvaqmdTbkfUGNi8Yu0L/T4cxuOlQlx3zGZ9X9Qx0+oZjknWK+QHrdWTcpS+zH4Hi7fP6kanOQoQ90Hj6Ghl57VU1GEdUPywSw4i1/7t0Wv9uT9Q2ktHp2rqVo3xkC9IVIpL7EZAxdRviIN2OsOB3g4a/F1ZpjxcAaZeOMUugiAX1+GtkLuE0Xn4neYjCaOghLxQTdhybN70VtnkiQLx/X9NjkDIl/spYGm3tQFMyYKkP6IWoEpj0926hJ0fmlmhy8tAOhlZsb/baW5cgkEZ3E9jVVrySCgQzoLQgma610FIISRpRJbSyv26jU7MkMxiyuBiDaFOORkXFttoKbtQKBgEbDS9II2brsz+vfI7uP8atFcawkE52cx4M1UWQhqb1H3tBiRl+qO+dMq1pPQF2bW7dlZAWYzS4W/367bTAuALHBDGB8xi1P4Njhh9vaOgTvuqrHG9NJQ85BLy0qGw8rjIWSIXVmVpfrXFJ8po5l04UE258Ll2yocv3QRQmddQW9"

-dummyKey384 :: C.PublicKey 'C.RSA
+dummyKey384 :: C.PublicKey
 dummyKey384 = "MIICITANBgkqhkiG9w0BAQEFAAOCAg4AMIICCQKCAYEAthExp77lSFBMB0RedjgKIU+oNH5lMGdMqDCG0E5Ly7X49rFpfDMMN08GDIgvzg9kcwV3ScbPcjUE19wmAShX9f9k3w38KM3wmIBKSiuCREQl0V3xAYp1SYwiAkMNSSwxuIkDEeSOR56WdEcZvqbB4lY9MQlUv70KriPDxZaqKCTKslUezXHQuYPQX6eMnGFK7hxz5Kl5MajV52d+5iXsa8CA+m/e1KVnbelCO+xhN89xG8ALt0CJ9k5Wwo3myLgXi4dmNankCmg8jkh+7y2ywkzxMwH1JydDtV/FLzkbZsbPR2w93TNrTq1RJOuqMyh0VtdBSpxNW/Ft988TkkX2BAWzx82INw7W6/QbHGNtHNB995R4sgeYy8QbEpNGBhQnfQh7yRWygLTVXWKApQzzfCeIoDDWUS7dMv/zXoasAnpDBj+6UhHv3BHrps7kBvRyZQ2d/nUuAqiGd43ljJ++n6vNyFLgZoiV7HLia/FOGMkdt7j92CNmFHxiT6Xl7kRHAoGBAPNoWny2O7LBxzAKMLmQVHBAiKp6RMx+7URvtQDHDHPaZ7F3MvtvmYWwGzund3cQFAaV1EkJoYeI3YRuj6xdXgMyMaP54On++btArb6jUtZuvlC98qE8dEEHQNh+7TsCiMU+ivbeKFxS9A/B7OVedoMnPoJWhatbA9zB/6L1GNPh"

-dummyKey512 :: C.PublicKey 'C.RSA
+dummyKey512 :: C.PublicKey
 dummyKey512 = "MIICoDANBgkqhkiG9w0BAQEFAAOCAo0AMIICiAKCAgEArkCY9DuverJ4mmzDektv9aZMFyeRV46WZK9NsOBKEc+1ncqMs+LhLti9asKNgUBRbNzmbOe0NYYftrUpwnATaenggkTFxxbJ4JGJuGYbsEdFWkXSvrbWGtM8YUmn5RkAGme12xQ89bSM4VoJAGnrYPHwmcQd+KYCPZvTUsxaxgrJTX65ejHN9BsAn8XtGViOtHTDJO9yUMD2WrJvd7wnNa+0ugEteDLzMU++xS98VC+uA1vfauUqi3yXVchdfrLdVUuM+JE0gUEXCgzjuHkaoHiaGNiGhdPYoAJJdOKQOIHAKdk7Th6OPhirPhc9XYNB4O8JDthKhNtfokvFIFlC4QBRzJhpLIENaEBDt08WmgpOnecZB/CuxkqqOrNa8j5K5jNrtXAI67W46VEC2jeQy/gZwb64Zit2A4D00xXzGbQTPGj4ehcEMhLx5LSCygViEf0w0tN3c3TEyUcgPzvECd2ZVpQLr9Z4a07Ebr+YSuxcHhjg4Rg1VyJyOTTvaCBGm5X2B3+tI4NUttmikIHOYpBnsLmHY2BgfH2KcrIsDyAhInXmTFr/L2+erFarUnlfATd2L8Ti43TNHDedO6k6jI5Gyi62yPwjqPLEIIK8l+pIeNfHJ3pPmjhHBfzFcQLMMMXffHWNK8kWklrQXK+4j4HiPcTBvlO1FEtG9nEIZhUCgYA4a6WtI2k5YNli1C89GY5rGUY7RP71T6RWri/D3Lz9T7GvU+FemAyYmsvCQwqijUOur0uLvwSP8VdxpSUcrjJJSWur2hrPWzWlu0XbNaeizxpFeKbQP+zSrWJ1z8RwfAeUjShxt8q1TuqGqY10wQyp3nyiTGvS+KwZVj5h5qx8NQ=="

 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
-client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server {subscribedQ, ntfSubscribedQ, notifiers} =
+client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} =
  forever $
    atomically (readTBQueue rcvQ)
      >>= processCommand
-      >>= atomically . writeTBQueue sndQ'
+      >>= atomically . writeTBQueue sndQ
  where
    processCommand :: Transmission -> m Transmission
    processCommand (corrId, queueId, cmd) = do
      st <- asks queueStore
      case cmd of
-        Cmd SBroker _ -> pure (corrId, queueId, cmd)
+        Cmd SBroker END -> unsubscribeQueue $> (corrId, queueId, cmd)
+        Cmd SBroker _ -> return (corrId, queueId, cmd)
        Cmd SSender command -> case command of
          SEND msgBody -> sendMessage st msgBody
          PING -> return (corrId, queueId, Cmd SBroker PONG)
-        Cmd SNotifier NSUB -> subscribeNotifications
        Cmd SRecipient command -> case command of
          NEW rKey -> createQueue st rKey
          SUB -> subscribeQueue queueId
          ACK -> acknowledgeMsg
          KEY sKey -> secureQueue_ st sKey
-          NKEY nKey -> addQueueNotifier_ st nKey
          OFF -> suspendQueue_ st
          DEL -> delQueueAndMsgs st
      where
        createQueue :: QueueStore -> RecipientPublicKey -> m Transmission
-        createQueue st rKey = checkKeySize rKey $ addQueueRetry 3
+        createQueue st rKey =
+          checkKeySize rKey addSubscribe
          where
-            addQueueRetry :: Int -> m (Command 'Broker)
-            addQueueRetry 0 = pure $ ERR INTERNAL
-            addQueueRetry n = do
-              ids@(rId, sId) <- getIds
-              atomically (addQueue st rKey ids) >>= \case
-                Left DUPLICATE_ -> addQueueRetry $ n - 1
-                Left e -> pure $ ERR e
-                Right _ -> do
+            addSubscribe =
+              addQueueRetry 3 >>= \case
+                Left e -> return $ ERR e
+                Right (rId, sId) -> do
                  withLog (`logCreateById` rId)
                  subscribeQueue rId $> IDS rId sId

+            addQueueRetry :: Int -> m (Either ErrorType (RecipientId, SenderId))
+            addQueueRetry 0 = return $ Left INTERNAL
+            addQueueRetry n = do
+              ids <- getIds
+              atomically (addQueue st rKey ids) >>= \case
+                Left DUPLICATE_ -> addQueueRetry $ n - 1
+                Left e -> return $ Left e
+                Right _ -> return $ Right ids
+
            logCreateById :: StoreLog 'WriteMode -> RecipientId -> IO ()
            logCreateById s rId =
              atomically (getQueue st SRecipient rId) >>= \case
@@ -271,24 +258,10 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
          withLog $ \s -> logSecureQueue s queueId sKey
          atomically . checkKeySize sKey $ either ERR (const OK) <$> secureQueue st queueId sKey

-        addQueueNotifier_ :: QueueStore -> NotifierPublicKey -> m Transmission
-        addQueueNotifier_ st nKey = checkKeySize nKey $ addNotifierRetry 3
-          where
-            addNotifierRetry :: Int -> m (Command 'Broker)
-            addNotifierRetry 0 = pure $ ERR INTERNAL
-            addNotifierRetry n = do
-              nId <- randomId =<< asks (queueIdBytes . config)
-              atomically (addQueueNotifier st queueId nId nKey) >>= \case
-                Left DUPLICATE_ -> addNotifierRetry $ n - 1
-                Left e -> pure $ ERR e
-                Right _ -> do
-                  withLog $ \s -> logAddNotifier s queueId nId nKey
-                  pure $ NID nId
-
-        checkKeySize :: Monad m' => C.APublicVerifyKey -> m' (Command 'Broker) -> m' Transmission
+        checkKeySize :: Monad m' => C.PublicKey -> m' (Command 'Broker) -> m' Transmission
        checkKeySize key action =
          mkResp corrId queueId
-            <$> if C.validKeySize key
+            <$> if C.validKeySize $ C.publicKeySize key
              then action
              else pure . ERR $ CMD KEY_SIZE

@@ -312,13 +285,11 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
              writeTVar subscriptions $ M.insert rId s subs
              return s

-        subscribeNotifications :: m Transmission
-        subscribeNotifications = atomically $ do
-          subs <- readTVar ntfSubscriptions
-          when (isNothing $ M.lookup queueId subs) $ do
-            writeTBQueue ntfSubscribedQ (queueId, clnt)
-            writeTVar ntfSubscriptions $ M.insert queueId () subs
-          pure ok
+        unsubscribeQueue :: m ()
+        unsubscribeQueue = do
+          sub <- atomically . stateTVar subscriptions $
+            \cs -> (M.lookup queueId cs, M.delete queueId cs)
+          mapM_ cancelSub sub

        acknowledgeMsg :: m Transmission
        acknowledgeMsg =
@@ -350,20 +321,9 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
                quota <- asks $ msgQueueQuota . config
                atomically $ do
                  q <- getMsgQueue ms (recipientId qr) quota
-                  ifM (isFull q) (pure $ err QUOTA) $ do
-                    trySendNotification
-                    writeMsg q msg
-                    pure ok
-              where
-                trySendNotification :: STM ()
-                trySendNotification =
-                  forM_ (notifier qr) $ \(nId, _) ->
-                    mapM_ (writeNtf nId) . M.lookup nId =<< readTVar notifiers
-
-                writeNtf :: NotifierId -> Client -> STM ()
-                writeNtf nId Client {sndQ} =
-                  unlessM (isFullTBQueue sndQ) $
-                    writeTBQueue sndQ $ mkResp (CorrId B.empty) nId NMSG
+                  isFull q >>= \case
+                    False -> writeMsg q msg $> ok
+                    True -> pure $ err QUOTA

        deliverMessage :: (MsgQueue -> STM (Maybe Message)) -> RecipientId -> Sub -> m Transmission
        deliverMessage tryPeek rId = \case
@@ -387,7 +347,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server
            subscriber :: MsgQueue -> m ()
            subscriber q = atomically $ do
              msg <- peekMsg q
-              writeTBQueue sndQ' $ mkResp (CorrId B.empty) rId (msgCmd msg)
+              writeTBQueue sndQ $ mkResp (CorrId "") rId (msgCmd msg)
              setSub (\s -> s {subThread = NoSub})
              void setDelivered

@@ -6,6 +6,7 @@
 module Simplex.Messaging.Server.Env.STM where

 import Control.Concurrent (ThreadId)
+import Control.Concurrent.STM (stateTVar)
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.Map.Strict (Map)
@@ -25,12 +26,13 @@ import UnliftIO.STM
 data ServerConfig = ServerConfig
  { transports :: [(ServiceName, ATransport)],
    tbqSize :: Natural,
+    serverTbqSize :: Natural,
    msgQueueQuota :: Natural,
    queueIdBytes :: Int,
    msgIdBytes :: Int,
    storeLog :: Maybe (StoreLog 'ReadMode),
    blockSize :: Int,
-    serverPrivateKey :: C.PrivateKey 'C.RSA
+    serverPrivateKey :: C.FullPrivateKey
    -- serverId :: ByteString
  }

@@ -40,22 +42,22 @@ data Env = Env
    queueStore :: QueueStore,
    msgStore :: STMMsgStore,
    idsDrg :: TVar ChaChaDRG,
-    serverKeyPair :: C.KeyPair 'C.RSA,
+    serverKeyPair :: C.FullKeyPair,
    storeLog :: Maybe (StoreLog 'WriteMode)
  }

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

 data Client = Client
  { subscriptions :: TVar (Map RecipientId Sub),
-    ntfSubscriptions :: TVar (Map NotifierId ()),
    rcvQ :: TBQueue Transmission,
-    sndQ :: TBQueue Transmission
+    sndQ :: TBQueue Transmission,
+    clientId :: Natural,
+    connected :: TVar Bool
  }

 data SubscriptionThread = NoSub | SubPending | SubThread ThreadId
@@ -67,19 +69,19 @@ data Sub = Sub

 newServer :: Natural -> STM Server
 newServer qSize = do
-  subscribedQ <- newTBQueue $ fromIntegral qSize
+  subscribedQ <- newTBQueue qSize
  subscribers <- newTVar M.empty
-  ntfSubscribedQ <- newTBQueue $ fromIntegral qSize
-  notifiers <- newTVar M.empty
-  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers}
+  nextClientId <- newTVar 0
+  return Server {subscribedQ, subscribers, nextClientId}

-newClient :: Natural -> STM Client
-newClient qSize = do
+newClient :: Server -> Natural -> STM Client
+newClient Server {nextClientId} qSize = do
  subscriptions <- newTVar M.empty
-  ntfSubscriptions <- newTVar M.empty
-  rcvQ <- newTBQueue $ fromIntegral qSize
-  sndQ <- newTBQueue $ fromIntegral qSize
-  return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ}
+  rcvQ <- newTBQueue qSize
+  sndQ <- newTBQueue qSize
+  clientId <- stateTVar nextClientId $ \i -> (i, i + 1)
+  connected <- newTVar True
+  return Client {subscriptions, rcvQ, sndQ, clientId, connected}

 newSubscription :: STM Sub
 newSubscription = do
@@ -88,29 +90,19 @@ newSubscription = do

 newEnv :: forall m. (MonadUnliftIO m, MonadRandom m) => ServerConfig -> m Env
 newEnv config = do
-  server <- atomically $ newServer (tbqSize config)
+  server <- atomically $ newServer (serverTbqSize config)
  queueStore <- atomically newQueueStore
  msgStore <- atomically newMsgStore
  idsDrg <- drgNew >>= newTVarIO
  s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
  let pk = serverPrivateKey config
-      serverKeyPair = (C.publicKey pk, pk)
+      serverKeyPair = (C.publicKey' pk, pk)
  return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair, storeLog = s'}
  where
    restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)
    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
-            }
+      atomically $ modifyTVar queueStore $ \d -> d {queues, senders = M.foldr' addSender M.empty queues}
      pure s'
    addSender :: QueueRec -> Map SenderId RecipientId -> Map SenderId RecipientId
    addSender q = M.insert (senderId q) (recipientId q)
-    addNotifier :: QueueRec -> Map NotifierId RecipientId -> Map NotifierId RecipientId
-    addNotifier q = case notifier q of
-      Nothing -> id
-      Just (nId, _) -> M.insert nId (recipientId q)
@@ -29,7 +29,7 @@ instance MonadMsgStore STMMsgStore MsgQueue STM where
    maybe (newQ m) return $ M.lookup rId m
    where
      newQ m' = do
-        q <- MsgQueue <$> newTBQueue (fromIntegral quota)
+        q <- MsgQueue <$> newTBQueue quota
        writeTVar store . MsgStoreData $ M.insert rId q m'
        return q

@@ -8,11 +8,10 @@ module Simplex.Messaging.Server.QueueStore where
 import Simplex.Messaging.Protocol

 data QueueRec = QueueRec
-  { recipientId :: RecipientId,
-    senderId :: SenderId,
+  { recipientId :: QueueId,
+    senderId :: QueueId,
    recipientKey :: RecipientPublicKey,
    senderKey :: Maybe SenderPublicKey,
-    notifier :: Maybe (NotifierId, NotifierPublicKey),
    status :: QueueStatus
  }

@@ -22,7 +21,6 @@ class MonadQueueStore s m where
  addQueue :: s -> RecipientPublicKey -> (RecipientId, SenderId) -> m (Either ErrorType ())
  getQueue :: s -> SParty (a :: Party) -> QueueId -> m (Either ErrorType QueueRec)
  secureQueue :: s -> RecipientId -> SenderPublicKey -> m (Either ErrorType ())
-  addQueueNotifier :: s -> RecipientId -> NotifierId -> NotifierPublicKey -> m (Either ErrorType ())
  suspendQueue :: s -> RecipientId -> m (Either ErrorType ())
  deleteQueue :: s -> RecipientId -> m (Either ErrorType ())

@@ -33,6 +31,5 @@ mkQueueRec recipientKey (recipientId, senderId) =
      senderId,
      recipientKey,
      senderKey = Nothing,
-      notifier = Nothing,
      status = QueueActive
    }
@@ -19,14 +19,13 @@ import UnliftIO.STM

 data QueueStoreData = QueueStoreData
  { queues :: Map RecipientId QueueRec,
-    senders :: Map SenderId RecipientId,
-    notifiers :: Map NotifierId RecipientId
+    senders :: Map SenderId RecipientId
  }

 type QueueStore = TVar QueueStoreData

 newQueueStore :: STM QueueStore
-newQueueStore = newTVar QueueStoreData {queues = M.empty, senders = M.empty, notifiers = M.empty}
+newQueueStore = newTVar QueueStoreData {queues = M.empty, senders = M.empty}

 instance MonadQueueStore QueueStore STM where
  addQueue :: QueueStore -> RecipientPublicKey -> (RecipientId, SenderId) -> STM (Either ErrorType ())
@@ -43,47 +42,22 @@ instance MonadQueueStore QueueStore STM where
        return $ Right ()

  getQueue :: QueueStore -> SParty (p :: Party) -> QueueId -> STM (Either ErrorType QueueRec)
-  getQueue st party qId = do
-    cs <- readTVar st
-    pure $ case party of
-      SRecipient -> getRcpQueue cs qId
-      SSender -> getPartyQueue cs senders
-      SNotifier -> getPartyQueue cs notifiers
-      SBroker -> Left INTERNAL
-    where
-      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
+  getQueue store SRecipient rId = do
+    cs <- readTVar store
+    return $ getRcpQueue cs rId
+  getQueue store SSender sId = do
+    cs <- readTVar store
+    let rId = M.lookup sId $ senders cs
+    return $ maybe (Left AUTH) (getRcpQueue cs) rId
+  getQueue _ SBroker _ =
+    return $ Left INTERNAL

-  secureQueue :: QueueStore -> RecipientId -> SenderPublicKey -> STM (Either ErrorType ())
  secureQueue store rId sKey =
    updateQueues store rId $ \cs c ->
      case senderKey c of
        Just _ -> (Left AUTH, cs)
        _ -> (Right (), cs {queues = M.insert rId c {senderKey = Just sKey} (queues cs)})

-  addQueueNotifier :: QueueStore -> RecipientId -> NotifierId -> NotifierPublicKey -> STM (Either ErrorType ())
-  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 store $
-              cs
-                { queues = M.insert rId q {notifier = Just (nId, nKey)} queues,
-                  notifiers = M.insert nId rId notifiers
-                }
-            pure $ Right ()
-
  suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ())
  suspendQueue store rId =
    updateQueues store rId $ \cs c ->
@@ -14,7 +14,6 @@ module Simplex.Messaging.Server.StoreLog
    closeStoreLog,
    logCreateQueue,
    logSecureQueue,
-    logAddNotifier,
    logDeleteQueue,
    readWriteStoreLog,
  )
@@ -51,44 +50,36 @@ data StoreLog (a :: IOMode) where
 data StoreLogRecord
  = CreateQueue QueueRec
  | SecureQueue QueueId SenderPublicKey
-  | AddNotifier QueueId NotifierId NotifierPublicKey
  | DeleteQueue QueueId

 storeLogRecordP :: Parser StoreLogRecord
 storeLogRecordP =
  "CREATE " *> createQueueP
    <|> "SECURE " *> secureQueueP
-    <|> "NOTIFIER " *> addNotifierP
    <|> "DELETE " *> (DeleteQueue <$> base64P)
  where
    createQueueP = CreateQueue <$> queueRecP
-    secureQueueP = SecureQueue <$> base64P <* A.space <*> C.strKeyP
-    addNotifierP =
-      AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.strKeyP
+    secureQueueP = SecureQueue <$> base64P <* A.space <*> C.pubKeyP
    queueRecP = do
      recipientId <- "rid=" *> base64P <* A.space
      senderId <- "sid=" *> base64P <* A.space
-      recipientKey <- "rk=" *> C.strKeyP <* A.space
-      senderKey <- "sk=" *> optional C.strKeyP
-      notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.strKeyP)
-      pure QueueRec {recipientId, senderId, recipientKey, senderKey, notifier, status = QueueActive}
+      recipientKey <- "rk=" *> C.pubKeyP <* A.space
+      senderKey <- "sk=" *> optional C.pubKeyP
+      pure QueueRec {recipientId, senderId, recipientKey, senderKey, status = QueueActive}

 serializeStoreLogRecord :: StoreLogRecord -> ByteString
 serializeStoreLogRecord = \case
  CreateQueue q -> "CREATE " <> serializeQueue q
-  SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializeKey sKey
-  AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializeKey nKey]
+  SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializePubKey sKey
  DeleteQueue rId -> "DELETE " <> encode rId
  where
-    serializeQueue QueueRec {recipientId, senderId, recipientKey, senderKey, notifier} =
+    serializeQueue QueueRec {recipientId, senderId, recipientKey, senderKey} =
      B.unwords
        [ "rid=" <> encode recipientId,
          "sid=" <> encode senderId,
-          "rk=" <> C.serializeKey recipientKey,
-          "sk=" <> maybe "" C.serializeKey senderKey
+          "rk=" <> C.serializePubKey recipientKey,
+          "sk=" <> maybe "" C.serializePubKey senderKey
        ]
-        <> maybe "" serializeNotifier notifier
-    serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializeKey nKey

 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = WriteStoreLog f <$> openFile f WriteMode
@@ -119,9 +110,6 @@ logCreateQueue s = writeStoreLogRecord s . CreateQueue
 logSecureQueue :: StoreLog 'WriteMode -> QueueId -> SenderPublicKey -> IO ()
 logSecureQueue s qId sKey = writeStoreLogRecord s $ SecureQueue qId sKey

-logAddNotifier :: StoreLog 'WriteMode -> QueueId -> NotifierId -> NotifierPublicKey -> IO ()
-logAddNotifier s qId nId nKey = writeStoreLogRecord s $ AddNotifier qId nId nKey
-
 logDeleteQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
 logDeleteQueue s = writeStoreLogRecord s . DeleteQueue

@@ -153,7 +141,6 @@ readQueues (ReadStoreLog _ h) = LB.hGetContents h >>= returnResult . procStoreLo
    procLogRecord m = \case
      CreateQueue q -> M.insert (recipientId q) q m
      SecureQueue qId sKey -> M.adjust (\q -> q {senderKey = Just sKey}) qId m
-      AddNotifier qId nId nKey -> M.adjust (\q -> q {notifier = Just (nId, nKey)}) qId m
      DeleteQueue qId -> M.delete qId m
    printError :: LogParsingError -> IO ()
    printError (e, s) = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
@@ -1,5 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -128,7 +128,7 @@ data ATransport = forall c. Transport c => ATransport (TProxy c)
 runTransportServer :: (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> (c -> m ()) -> m ()
 runTransportServer started port server = do
  clients <- newTVarIO S.empty
-  E.bracket (liftIO $ startTCPServer started port) (liftIO . closeServer clients) $ \sock -> forever $ do
+  E.bracket (liftIO $ startTCPServer started port) (liftIO . closeServer clients) \sock -> forever $ do
    c <- liftIO $ acceptConnection sock
    tid <- forkFinally (server c) (const $ liftIO $ closeConnection c)
    atomically . modifyTVar clients $ S.insert tid
@@ -150,8 +150,7 @@ startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
    open addr = do
      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
      setSocketOption sock ReuseAddr 1
-      -- removed for GHC 8.4.4
-      -- withFdSocket sock setCloseOnExecIfNeeded
+      withFdSocket sock setCloseOnExecIfNeeded
      bind sock $ addrAddress addr
      listen sock 1024
      return sock
@@ -193,7 +192,7 @@ instance Transport TCP where
  transportName _ = "TCP"
  getServerConnection = fmap TCP . getSocketHandle
  getClientConnection = getServerConnection
-  closeConnection (TCP h) = hClose h `E.catch` \(_ :: E.SomeException) -> pure ()
+  closeConnection = hClose . tcpHandle
  cGet = B.hGet . tcpHandle
  cPut = B.hPut . tcpHandle
  getLn = fmap trimCR . B.hGetLine . tcpHandle
@@ -223,7 +222,7 @@ major :: SMPVersion -> (Int, Int)
 major (SMPVersion a b _ _) = (a, b)

 currentSMPVersion :: SMPVersion
-currentSMPVersion = "0.5.0.0"
+currentSMPVersion = "0.5.1.0"

 currentSMPVersionStr :: ByteString
 currentSMPVersionStr = serializeSMPVersion currentSMPVersion
@@ -315,7 +314,7 @@ tPutEncrypted :: Transport c => THandle c -> ByteString -> IO (Either TransportE
 tPutEncrypted THandle {connection = c, sndKey, blockSize} block =
  encryptBlock sndKey (blockSize - C.authTagSize) block >>= \case
    Left _ -> pure $ Left TEEncrypt
-    Right (authTag, msg) -> Right <$> cPut c (msg <> C.authTagToBS authTag)
+    Right (authTag, msg) -> Right <$> cPut c (C.authTagToBS authTag <> msg)

 -- | Receive and decrypt block from SMP encrypted transport.
 tGetEncrypted :: Transport c => THandle c -> IO (Either TransportError ByteString)
@@ -332,7 +331,7 @@ encryptBlock k@SessionKey {aesKey} size block = do

 decryptBlock :: SessionKey -> ByteString -> IO (Either C.CryptoError ByteString)
 decryptBlock k@SessionKey {aesKey} block = do
-  let (msg', authTag) = B.splitAt (B.length block - C.authTagSize) block
+  let (authTag, msg') = B.splitAt C.authTagSize block
  ivBytes <- makeNextIV k
  runExceptT $ C.decryptAES aesKey ivBytes msg' (C.bsToAuthTag authTag)

@@ -350,7 +349,7 @@ makeNextIV SessionKey {baseIV, counter} = atomically $ do
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
 --
 -- The numbers in function names refer to the steps in the document.
-serverHandshake :: forall c. Transport c => c -> Int -> C.KeyPair 'C.RSA -> ExceptT TransportError IO (THandle c)
+serverHandshake :: forall c. Transport c => c -> Int -> C.FullKeyPair -> ExceptT TransportError IO (THandle c)
 serverHandshake c srvBlockSize (k, pk) = do
  checkValidBlockSize srvBlockSize
  liftIO sendHeaderAndPublicKey_1
@@ -363,13 +362,13 @@ serverHandshake c srvBlockSize (k, pk) = do
  where
    sendHeaderAndPublicKey_1 :: IO ()
    sendHeaderAndPublicKey_1 = do
-      let sKey = C.encodeKey k
+      let sKey = C.encodePubKey k
          header = ServerHeader {blockSize = srvBlockSize, keySize = B.length sKey}
      cPut c $ binaryServerHeader header
      cPut c sKey
    receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString
    receiveEncryptedKeys_4 =
-      liftIO (cGet c $ C.keySize k) >>= \case
+      liftIO (cGet c $ C.publicKeySize k) >>= \case
        "" -> throwE $ TEHandshake TERMINATED
        ks -> pure ks
    decryptParseKeys_5 :: ByteString -> ExceptT TransportError IO ClientHandshake
@@ -395,7 +394,7 @@ clientHandshake c blkSize_ keyHash = do
  getWelcome_6 th >>= checkVersion
  pure th
  where
-    getHeaderAndPublicKey_1_2 :: ExceptT TransportError IO (C.PublicKey 'C.RSA, Int)
+    getHeaderAndPublicKey_1_2 :: ExceptT TransportError IO (C.PublicKey, Int)
    getHeaderAndPublicKey_1_2 = do
      header <- liftIO (cGet c serverHeaderSize)
      ServerHeader {blockSize, keySize} <- liftEither $ parse serverHeaderP (TEHandshake HEADER) header
@@ -404,8 +403,8 @@ clientHandshake c blkSize_ keyHash = do
      maybe (pure ()) (validateKeyHash_2 s) keyHash
      key <- liftEither $ parseKey s
      pure (key, blockSize)
-    parseKey :: ByteString -> Either TransportError (C.PublicKey 'C.RSA)
-    parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryKeyP
+    parseKey :: ByteString -> Either TransportError C.PublicKey
+    parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryPubKeyP
    validateKeyHash_2 :: ByteString -> C.KeyHash -> ExceptT TransportError IO ()
    validateKeyHash_2 k (C.KeyHash kHash)
      | C.sha256Hash k == kHash = pure ()
@@ -417,7 +416,7 @@ clientHandshake c blkSize_ keyHash = do
      aesKey <- C.randomAesKey
      baseIV <- C.randomIV
      pure SessionKey {aesKey, baseIV, counter = undefined}
-    sendEncryptedKeys_4 :: C.PublicKey 'C.RSA -> ClientHandshake -> ExceptT TransportError IO ()
+    sendEncryptedKeys_4 :: C.PublicKey -> ClientHandshake -> ExceptT TransportError IO ()
    sendEncryptedKeys_4 k chs =
      liftError (const $ TEHandshake ENCRYPT) (C.encryptOAEP k $ serializeClientHandshake chs)
        >>= liftIO . cPut c
@@ -1,32 +1,14 @@
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

 module Simplex.Messaging.Util where

-import Control.Concurrent.STM
-import Control.Monad.Fail (MonadFail)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import UnliftIO.Async
-import UnliftIO.Exception (Exception)
-import qualified UnliftIO.Exception as E
-
-newtype InternalException e = InternalException {unInternalException :: e}
-  deriving (Eq, Show)
-
-instance Exception e => Exception (InternalException e)
-
-instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
-  withRunInIO :: ((forall a. ExceptT e m a -> IO a) -> IO b) -> ExceptT e m b
-  withRunInIO exceptToIO =
-    withExceptT unInternalException . ExceptT . E.try $
-      withRunInIO $ \run ->
-        exceptToIO $ run . (either (E.throwIO . InternalException) return <=< runExceptT)

 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
 raceAny_ = r []
@@ -45,9 +27,6 @@ f <$?> m = m >>= either fail pure . f
 bshow :: Show a => a -> ByteString
 bshow = B.pack . show

-maybeWord :: (a -> ByteString) -> Maybe a -> ByteString
-maybeWord f = maybe "" $ B.cons ' ' . f
-
 liftIOEither :: (MonadIO m, MonadError e m) => IO (Either e a) -> m a
 liftIOEither a = liftIO a >>= liftEither

@@ -62,14 +41,8 @@ tryError action = (Right <$> action) `catchError` (pure . Left)

 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 #-}

 unlessM :: Monad m => m Bool -> m () -> m ()
 unlessM b = ifM b $ pure ()
-
-stateTVar :: TVar s -> (s -> (a, s)) -> STM a
-stateTVar var f = do
-   s <- readTVar var
-   let (a, s') = f s -- since we destructure this, we are strict in f
-   writeTVar var s'
-   return a
-{-# INLINE stateTVar #-}
+{-# INLINE unlessM #-}
@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-12.26
+resolver: lts-18.21

 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -35,10 +35,8 @@ packages:
 # forks / in-progress versions pinned to a git hash. For example:
 #
 extra-deps:
-  - cryptostore-0.2.0.0
-  - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718
-  - simple-logger-0.0.4
-  - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
+  - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
+  - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
 # - network-run-0.2.4@sha256:7dbb06def522dab413bce4a46af476820bffdff2071974736b06f52f4ab57c96,885
 # - git: https://github.com/commercialhaskell/stack.git
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -13,6 +14,7 @@ import AgentTests.ConnectionRequestTests
 import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.SQLiteTests (storeTests)
 import Control.Concurrent
+import Control.Monad (forM_)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Network.HTTP.Types (urlEncode)
@@ -22,6 +24,7 @@ import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as A
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..), TProxy (..), Transport (..))
+import Simplex.Messaging.Util (bshow)
 import System.Directory (removeFile)
 import System.Timeout
 import Test.Hspec
@@ -32,7 +35,7 @@ agentTests (ATransport t) = do
  describe "Functional API" $ functionalAPITests (ATransport t)
  describe "SQLite store" storeTests
  describe "SMP agent protocol syntax" $ syntaxTests t
-  describe "Establishing duplex connection" $ do
+  describe "Establishing duplex connection" do
    it "should connect via one server and one agent" $
      smpAgentTest2_1_1 $ testDuplexConnection t
    it "should connect via one server and one agent (random IDs)" $
@@ -45,23 +48,27 @@ agentTests (ATransport t) = do
      smpAgentTest2_2_2 $ testDuplexConnection t
    it "should connect via 2 servers and 2 agents (random IDs)" $
      smpAgentTest2_2_2 $ testDuplexConnRandomIds t
-  describe "Establishing connections via `contact connection`" $ do
+  describe "Establishing connections via `contact connection`" do
    it "should connect via contact connection with one server and 3 agents" $
      smpAgentTest3 $ testContactConnection t
    it "should connect via contact connection with one server and 2 agents (random IDs)" $
      smpAgentTest2_2_1 $ testContactConnRandomIds t
    it "should support rejecting contact request" $
      smpAgentTest2_2_1 $ testRejectContactRequest t
-  describe "Connection subscriptions" $ do
+  describe "Connection subscriptions" do
    it "should connect via one server and one agent" $
      smpAgentTest3_1_1 $ testSubscription t
    it "should send notifications to client when server disconnects" $
      smpAgentServerTest $ testSubscrNotification t
-  describe "Message delivery" $ do
+  describe "Message delivery" do
    it "should deliver messages after losing server connection and re-connecting" $
      smpAgentTest2_2_2_needs_server $ testMsgDeliveryServerRestart t
    it "should deliver pending messages after agent restarting" $
      smpAgentTest1_1_1 $ testMsgDeliveryAgentRestart t
+    it "should concurrently deliver messages to connections without blocking" $
+      smpAgentTest2_2_1 $ testConcurrentMsgDelivery t
+    it "should deliver messages if one of connections has quota exceeded" $
+      smpAgentTest2_2_1 $ testMsgDeliveryQuotaExceeded t

 -- | receive message to handle `h`
 (<#:) :: Transport c => c -> IO (ATransmissionOrError 'Agent)
@@ -324,6 +331,47 @@ testMsgDeliveryAgentRestart t bob = do
    withServer test' = withSmpServerStoreLogOn (ATransport t) testPort2 (const test') `shouldReturn` ()
    withAgent = withSmpAgentThreadOn_ (ATransport t) (agentTestPort, testPort, testDB) (pure ()) . const . testSMPAgentClientOn agentTestPort

+testConcurrentMsgDelivery :: Transport c => TProxy c -> c -> c -> IO ()
+testConcurrentMsgDelivery _ alice bob = do
+  connect (alice, "alice") (bob, "bob")
+
+  ("1", "bob2", Right (INV cReq)) <- alice #: ("1", "bob2", "NEW INV")
+  let cReq' = serializeConnReq cReq
+  bob #: ("11", "alice2", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice2", OK)
+  ("", "bob2", Right (CONF _confId "bob's connInfo")) <- (alice <#:)
+  -- below commands would be needed to accept bob's connection, but alice does not
+  -- alice #: ("2", "bob", "LET " <> _confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
+  -- bob <# ("", "alice", INFO "alice's connInfo")
+  -- bob <# ("", "alice", CON)
+  -- alice <# ("", "bob", CON)
+
+  -- the first connection should not be blocked by the second one
+  sendMessage (alice, "alice") (bob, "bob") "hello"
+  -- alice #: ("2", "bob", "SEND :hello") #> ("2", "bob", MID 1)
+  -- alice <# ("", "bob", SENT 1)
+  -- bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
+  -- bob #: ("12", "alice", "ACK 1") #> ("12", "alice", OK)
+  bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 2)
+  bob <# ("", "alice", SENT 2)
+  -- if delivery is blocked it won't go further
+  alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
+  alice #: ("3", "bob", "ACK 2") #> ("3", "bob", OK)
+
+testMsgDeliveryQuotaExceeded :: Transport c => TProxy c -> c -> c -> IO ()
+testMsgDeliveryQuotaExceeded _ alice bob = do
+  connect (alice, "alice") (bob, "bob")
+  connect (alice, "alice2") (bob, "bob2")
+  forM_ [1 .. 4 :: Int] $ \i -> do
+    let corrId = bshow i
+        msg = "message " <> bshow i
+    (_, "bob", Right (MID mId)) <- alice #: (corrId, "bob", "SEND :" <> msg)
+    alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False
+  (_, "bob", Right (MID _)) <- alice #: ("5", "bob", "SEND :over quota")
+
+  alice #: ("1", "bob2", "SEND :hello") #> ("1", "bob2", MID 1)
+  -- if delivery is blocked it won't go further
+  alice <# ("", "bob2", SENT 1)
+
 connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO ()
 connect (h1, name1) (h2, name2) = do
  ("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW INV")
@@ -335,6 +383,16 @@ connect (h1, name1) (h2, name2) = do
  h2 <# ("", name1, CON)
  h1 <# ("", name2, CON)

+sendMessage :: Transport c => (c, ConnId) -> (c, ConnId) -> ByteString -> IO ()
+sendMessage (h1, name1) (h2, name2) msg = do
+  ("m1", name2', Right (MID mId)) <- h1 #: ("m1", name2, "SEND :" <> msg)
+  name2' `shouldBe` name2
+  h1 <#= \case ("", n, SENT m) -> n == name2 && m == mId; _ -> False
+  ("", name1', Right (MSG MsgMeta {recipient = (msgId, _)} msg')) <- (h2 <#:)
+  name1' `shouldBe` name1
+  msg' `shouldBe` msg
+  h2 #: ("m2", name1, "ACK " <> bshow msgId) =#> \case ("m2", n, OK) -> n == name1; _ -> False
+
 -- connect' :: forall c. Transport c => c -> c -> IO (ByteString, ByteString)
 -- connect' h1 h2 = do
 --   ("c1", conn2, Right (INV cReq)) <- h1 #: ("c1", "", "NEW INV")
@@ -353,21 +411,21 @@ samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSG
 syntaxTests :: forall c. Transport c => TProxy c -> Spec
 syntaxTests t = do
  it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX")
-  describe "NEW" $ do
-    describe "valid" $ do
+  describe "NEW" do
+    describe "valid" do
      -- TODO: add tests with defined connection alias
      it "with correct parameter" $ ("211", "", "NEW INV") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
-    describe "invalid" $ do
+    describe "invalid" do
      -- TODO: add tests with defined connection alias
      it "with incorrect parameter" $ ("222", "", "NEW hi") >#> ("222", "", "ERR CMD SYNTAX")

-  describe "JOIN" $ do
-    describe "valid" $ do
+  describe "JOIN" do
+    describe "valid" do
      -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided)
      -- TODO: add tests with defined connection alias
      it "using same server as in invitation" $
-        ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5001%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH")
-    describe "invalid" $ do
+        ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5000%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH")
+    describe "invalid" do
      -- TODO: JOIN is not merged yet - to be added
      it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX")
  where
@@ -3,7 +3,6 @@

 module AgentTests.ConnectionRequestTests where

-import qualified Crypto.PubKey.RSA as R
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (parseAll)
@@ -37,7 +36,7 @@ connectionRequest =
    ConnReqData
      { crScheme = appServer,
        crSmpQueues = [queue],
-        crEncryptKey = C.APublicEncryptKey C.SRSA (C.PublicKeyRSA $ R.PublicKey 1 0 0)
+        crEncryptKey = reservedServerKey
      }

 connectionRequestTests :: Spec
@@ -12,7 +12,7 @@ import Control.Monad.IO.Unlift
 import SMPAgentClient
 import SMPClient (withSmpServer)
 import Simplex.Messaging.Agent
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
+import Simplex.Messaging.Agent.Env.SQLite (dbFile)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..))
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -22,6 +22,7 @@ import Data.Word (Word32)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import SMPClient (testKeyHash)
+import Simplex.Messaging.Agent.ExceptT ()
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
@@ -70,42 +71,42 @@ action `throwsError` e = runExceptT action `shouldReturn` Left e
 -- TODO add null port tests
 storeTests :: Spec
 storeTests = do
-  withStore2 $ do
+  withStore2 do
    describe "stress test" testConcurrentWrites
-  withStore $ do
-    describe "store setup" $ do
+  withStore do
+    describe "store setup" do
      testCompiledThreadsafe
      testForeignKeysEnabled
-    describe "store methods" $ do
-      describe "Queue and Connection management" $ do
-        describe "createRcvConn" $ do
+    describe "store methods" do
+      describe "Queue and Connection management" do
+        describe "createRcvConn" do
          testCreateRcvConn
          testCreateRcvConnRandomId
          testCreateRcvConnDuplicate
-        describe "createSndConn" $ do
+        describe "createSndConn" do
          testCreateSndConn
          testCreateSndConnRandomID
          testCreateSndConnDuplicate
        describe "getAllConnIds" testGetAllConnIds
        describe "getRcvConn" testGetRcvConn
-        describe "deleteConn" $ do
+        describe "deleteConn" do
          testDeleteRcvConn
          testDeleteSndConn
          testDeleteDuplexConn
-        describe "upgradeRcvConnToDuplex" $ do
+        describe "upgradeRcvConnToDuplex" do
          testUpgradeRcvConnToDuplex
-        describe "upgradeSndConnToDuplex" $ do
+        describe "upgradeSndConnToDuplex" do
          testUpgradeSndConnToDuplex
-        describe "set Queue status" $ do
-          describe "setRcvQueueStatus" $ do
+        describe "set Queue status" do
+          describe "setRcvQueueStatus" do
            testSetRcvQueueStatus
            testSetRcvQueueStatusNoQueue
-          describe "setSndQueueStatus" $ do
+          describe "setSndQueueStatus" do
            testSetSndQueueStatus
            testSetSndQueueStatusNoQueue
          testSetQueueStatusDuplex
-      describe "Msg management" $ do
-        describe "create Msg" $ do
+      describe "Msg management" do
+        describe "create Msg" do
          testCreateRcvMsg
          testCreateSndMsg
          testCreateRcvAndSndMsgs
@@ -149,41 +150,14 @@ testForeignKeysEnabled =
 cData1 :: ConnData
 cData1 = ConnData {connId = "conn1"}

-testPrivateSignKey :: C.APrivateSignKey
-testPrivateSignKey = C.APrivateSignKey C.SRSA testPrivateKey
-
-testPrivateDecryptKey :: C.APrivateDecryptKey
-testPrivateDecryptKey = C.APrivateDecryptKey C.SRSA testPrivateKey
-
-testPublicEncryptKey :: C.APublicEncryptKey
-testPublicEncryptKey = C.APublicEncryptKey C.SRSA $ C.PublicKeyRSA $ R.PublicKey 1 2 3
-
-testPrivateKey :: C.PrivateKey 'C.RSA
-testPrivateKey =
-  C.PrivateKeyRSA
-    R.PrivateKey
-      { private_pub =
-          R.PublicKey
-            { public_size = 1,
-              public_n = 2,
-              public_e = 0
-            },
-        private_d = 3,
-        private_p = 0,
-        private_q = 0,
-        private_dP = 0,
-        private_dQ = 0,
-        private_qinv = 0
-      }
-
 rcvQueue1 :: RcvQueue
 rcvQueue1 =
  RcvQueue
    { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
      rcvId = "1234",
-      rcvPrivateKey = testPrivateSignKey,
+      rcvPrivateKey = C.safePrivateKey (1, 2, 3),
      sndId = Just "2345",
-      decryptKey = testPrivateDecryptKey,
+      decryptKey = C.safePrivateKey (1, 2, 3),
      verifyKey = Nothing,
      status = New
    }
@@ -193,9 +167,9 @@ sndQueue1 =
  SndQueue
    { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
      sndId = "3456",
-      sndPrivateKey = testPrivateSignKey,
-      encryptKey = testPublicEncryptKey,
-      signKey = testPrivateSignKey,
+      sndPrivateKey = C.safePrivateKey (1, 2, 3),
+      encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
+      signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
      status = New
    }

@@ -333,9 +307,9 @@ testUpgradeRcvConnToDuplex =
          SndQueue
            { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
              sndId = "2345",
-              sndPrivateKey = testPrivateSignKey,
-              encryptKey = testPublicEncryptKey,
-              signKey = testPrivateSignKey,
+              sndPrivateKey = C.safePrivateKey (1, 2, 3),
+              encryptKey = C.PublicKey $ R.PublicKey 1 2 3,
+              signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey),
              status = New
            }
    upgradeRcvConnToDuplex store "conn1" anotherSndQueue
@@ -353,9 +327,9 @@ testUpgradeSndConnToDuplex =
          RcvQueue
            { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
              rcvId = "3456",
-              rcvPrivateKey = testPrivateSignKey,
+              rcvPrivateKey = C.safePrivateKey (1, 2, 3),
              sndId = Just "4567",
-              decryptKey = testPrivateDecryptKey,
+              decryptKey = C.safePrivateKey (1, 2, 3),
              verifyKey = Nothing,
              status = New
            }
@@ -1,4 +1,6 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -155,16 +157,16 @@ cfg :: AgentConfig
 cfg =
  defaultAgentConfig
    { tcpPort = agentTestPort,
-      smpServers = L.fromList ["localhost:5001#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
+      smpServers = L.fromList ["localhost:5000#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
      tbqSize = 1,
      dbFile = testDB,
      smpCfg =
        smpDefaultConfig
          { qSize = 1,
            defaultTransport = (testPort, transport @TCP),
-            tcpTimeout = 500000
+            tcpTimeout = 500_000
          },
-      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50000}
+      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50_000}
    }

 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
@@ -1,7 +1,8 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}

@@ -12,7 +13,6 @@ import Control.Monad.Except (runExceptT)
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Base64 (encode)
-import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Network.Socket
 import qualified Simplex.Messaging.Crypto as C
@@ -22,7 +22,6 @@ import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (openReadStoreLog)
 import Simplex.Messaging.Transport
 import Test.Hspec
-import qualified Control.Concurrent as CC
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, takeTMVar)
@@ -32,12 +31,12 @@ testHost :: HostName
 testHost = "localhost"

 testPort :: ServiceName
-testPort = "5001"
+testPort = "5000"

 testPort2 :: ServiceName
-testPort2 = "5002"
+testPort2 = "5001"

-testKeyHashStr :: ByteString
+testKeyHashStr :: B.ByteString
 testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="

 testBlockSize :: Maybe Int
@@ -61,6 +60,7 @@ cfg =
  ServerConfig
    { transports = undefined,
      tbqSize = 1,
+      serverTbqSize = 1,
      msgQueueQuota = 4,
      queueIdBytes = 12,
      msgIdBytes = 6,
@@ -112,11 +112,6 @@ withSmpServerThreadOn t port =
    (\started -> runSMPServerBlocking started cfg {transports = [(port, t)]})
    (pure ())

-forkIOWithUnmask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m ()) -> m ThreadId
-forkIOWithUnmask m =
-  withRunInIO $ \run -> CC.forkIOWithUnmask $ \unmask -> run $ m $ liftIO . unmask . run
-{-# INLINABLE forkIOWithUnmask #-}
-
 serverBracket :: MonadUnliftIO m => (TMVar Bool -> m ()) -> m () -> (ThreadId -> m a) -> m a
 serverBracket process afterProcess f = do
  started <- newEmptyTMVarIO
@@ -126,7 +121,7 @@ serverBracket process afterProcess f = do
    (\t -> waitFor started "start" >> f t)
  where
    waitFor started s =
-      5000000 `timeout` atomically (takeTMVar started) >>= \case
+      5_000_000 `timeout` atomically (takeTMVar started) >>= \case
        Nothing -> error $ "server did not " <> s
        _ -> pure ()

@@ -146,8 +141,8 @@ runSmpTestN nClients test = withSmpServer (transport @c) $ run nClients []
    run 0 hs = test hs
    run n hs = testSMPClient $ \h -> run (n - 1) (h : hs)

-smpServerTest :: forall c. Transport c => TProxy c -> SignedRawTransmission -> IO SignedRawTransmission
-smpServerTest _ t = runSmpTest $ \(h :: THandle c) -> tPutRaw h t >> tGetRaw h
+smpServerTest :: forall c. Transport c => TProxy c -> RawTransmission -> IO RawTransmission
+smpServerTest _ cmd = runSmpTest $ \(h :: THandle c) -> tPutRaw h cmd >> tGetRaw h

 smpTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
 smpTest _ test' = runSmpTest test' `shouldReturn` ()
@@ -167,18 +162,12 @@ smpTest3 _ test' = smpTestN 3 _test
    _test [h1, h2, h3] = test' h1 h2 h3
    _test _ = error "expected 3 handles"

-smpTest4 :: Transport c => TProxy c -> (THandle c -> THandle c -> THandle c -> THandle c -> IO ()) -> Expectation
-smpTest4 _ test' = smpTestN 4 _test
-  where
-    _test [h1, h2, h3, h4] = test' h1 h2 h3 h4
-    _test _ = error "expected 4 handles"
-
-tPutRaw :: Transport c => THandle c -> SignedRawTransmission -> IO ()
+tPutRaw :: Transport c => THandle c -> RawTransmission -> IO ()
 tPutRaw h (sig, corrId, queueId, command) = do
  let t = B.intercalate " " [corrId, queueId, command]
-  void $ tPut h (sig, t)
+  void $ tPut h (C.Signature sig, t)

-tGetRaw :: Transport c => THandle c -> IO SignedRawTransmission
+tGetRaw :: Transport c => THandle c -> IO RawTransmission
 tGetRaw h = do
-  (Nothing, (CorrId corrId, qId, Right cmd)) <- tGet fromServer h
-  pure (Nothing, corrId, encode qId, serializeCommand cmd)
+  ("", (CorrId corrId, qId, Right cmd)) <- tGet fromServer h
+  pure ("", corrId, encode qId, serializeCommand cmd)
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -10,7 +11,7 @@ module ServerTests where
 import Control.Concurrent (ThreadId, killThread)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
-import Control.Monad.Except (forM_, runExceptT)
+import Control.Monad.Except (forM, forM_, runExceptT)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -30,27 +31,27 @@ rsaKeySize = 2048 `div` 8
 serverTests :: ATransport -> Spec
 serverTests t = do
  describe "SMP syntax" $ syntaxTests t
-  describe "SMP queues" $ do
+  describe "SMP queues" do
    describe "NEW and KEY commands, SEND messages" $ testCreateSecure t
    describe "NEW, OFF and DEL commands, SEND messages" $ testCreateDelete t
-  describe "SMP messages" $ do
+    describe "Stress test" $ stressTest t
+  describe "SMP messages" do
    describe "duplex communication over 2 SMP connections" $ testDuplex t
    describe "switch subscription to another SMP queue" $ testSwitchSub t
  describe "Store log" $ testWithStoreLog t
  describe "Timing of AUTH error" $ testTiming t
-  describe "Message notifications" $ testMessageNotifications t

 pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmissionOrError
 pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command)))

-sendRecv :: Transport c => THandle c -> (Maybe C.ASignature, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
+sendRecv :: Transport c => THandle c -> (ByteString, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
 sendRecv h (sgn, corrId, qId, cmd) = tPutRaw h (sgn, corrId, encode qId, cmd) >> tGet fromServer h

-signSendRecv :: Transport c => THandle c -> C.APrivateSignKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
+signSendRecv :: Transport c => THandle c -> C.SafePrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
 signSendRecv h pk (corrId, qId, cmd) = do
  let t = B.intercalate " " [corrId, encode qId, cmd]
  Right sig <- runExceptT $ C.sign pk t
-  _ <- tPut h (Just sig, t)
+  _ <- tPut h (sig, t)
  tGet fromServer h

 cmdSEND :: ByteString -> ByteString
@@ -63,8 +64,8 @@ testCreateSecure :: ATransport -> Spec
 testCreateSecure (ATransport t) =
  it "should create (NEW) and secure (KEY) queue" $
    smpTest t $ \h -> do
-      (rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-      Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
+      (rPub, rKey) <- C.generateKeyPair rsaKeySize
+      Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
      (rId1, "") #== "creates queue"

      Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, "SEND 5 hello ")
@@ -80,12 +81,12 @@ testCreateSecure (ATransport t) =
      Resp "dabc" _ err6 <- signSendRecv h rKey ("dabc", rId, "ACK")
      (err6, ERR NO_MSG) #== "replies ERR when message acknowledged without messages"

-      (sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
+      (sPub, sKey) <- C.generateKeyPair rsaKeySize
      Resp "abcd" sId2 err1 <- signSendRecv h sKey ("abcd", sId, "SEND 5 hello ")
      (err1, ERR AUTH) #== "rejects signed SEND"
      (sId2, sId) #== "same queue ID in response 2"

-      let keyCmd = "KEY " <> C.serializeKey sPub
+      let keyCmd = "KEY " <> C.serializePubKey sPub
      Resp "bcda" _ err2 <- sendRecv h (sampleSig, "bcda", rId, keyCmd)
      (err2, ERR AUTH) #== "rejects KEY with wrong signature"

@@ -115,12 +116,12 @@ testCreateDelete :: ATransport -> Spec
 testCreateDelete (ATransport t) =
  it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
    smpTest2 t $ \rh sh -> do
-      (rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-      Resp "abcd" rId1 (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
+      (rPub, rKey) <- C.generateKeyPair rsaKeySize
+      Resp "abcd" rId1 (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
      (rId1, "") #== "creates queue"

-      (sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-      Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, "KEY " <> C.serializeKey sPub)
+      (sPub, sKey) <- C.generateKeyPair rsaKeySize
+      Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, "KEY " <> C.serializePubKey sPub)
      (ok1, OK) #== "secures queue"

      Resp "cdab" _ ok2 <- signSendRecv sh sKey ("cdab", sId, "SEND 5 hello ")
@@ -179,26 +180,42 @@ testCreateDelete (ATransport t) =
      Resp "cdab" _ err10 <- signSendRecv rh rKey ("cdab", rId, "SUB")
      (err10, ERR AUTH) #== "rejects SUB when deleted"

+stressTest :: ATransport -> Spec
+stressTest (ATransport t) =
+  it "should create many queues, disconnect and re-connect" $
+    smpTest3 t $ \h1 h2 h3 -> do
+      (rPub, rKey) <- C.generateKeyPair rsaKeySize
+      rIds <- forM [1 .. 50 :: Int] . const $ do
+        Resp "" "" (IDS rId _) <- signSendRecv h1 rKey ("", "", "NEW " <> C.serializePubKey rPub)
+        pure rId
+      let subscribeQueues h = forM_ rIds $ \rId -> do
+            Resp "" rId' OK <- signSendRecv h rKey ("", rId, "SUB")
+            rId' `shouldBe` rId
+      closeConnection $ connection h1
+      subscribeQueues h2
+      closeConnection $ connection h2
+      subscribeQueues h3
+
 testDuplex :: ATransport -> Spec
 testDuplex (ATransport t) =
  it "should create 2 simplex connections and exchange messages" $
    smpTest2 t $ \alice bob -> do
-      (arPub, arKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-      Resp "abcd" _ (IDS aRcv aSnd) <- signSendRecv alice arKey ("abcd", "", "NEW " <> C.serializeKey arPub)
+      (arPub, arKey) <- C.generateKeyPair rsaKeySize
+      Resp "abcd" _ (IDS aRcv aSnd) <- signSendRecv alice arKey ("abcd", "", "NEW " <> C.serializePubKey arPub)
      -- aSnd ID is passed to Bob out-of-band

-      (bsPub, bsKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-      Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, cmdSEND $ "key " <> C.serializeKey bsPub)
+      (bsPub, bsKey) <- C.generateKeyPair rsaKeySize
+      Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, cmdSEND $ "key " <> C.serializePubKey bsPub)
      -- "key ..." is ad-hoc, different from SMP protocol

      Resp "" _ (MSG _ _ msg1) <- tGet fromServer alice
      Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, "ACK")
      ["key", bobKey] <- return $ B.words msg1
-      (bobKey, C.serializeKey bsPub) #== "key received from Bob"
+      (bobKey, C.serializePubKey bsPub) #== "key received from Bob"
      Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, "KEY " <> bobKey)

-      (brPub, brKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-      Resp "abcd" _ (IDS bRcv bSnd) <- signSendRecv bob brKey ("abcd", "", "NEW " <> C.serializeKey brPub)
+      (brPub, brKey) <- C.generateKeyPair rsaKeySize
+      Resp "abcd" _ (IDS bRcv bSnd) <- signSendRecv bob brKey ("abcd", "", "NEW " <> C.serializePubKey brPub)
      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, cmdSEND $ "reply_id " <> encode bSnd)
      -- "reply_id ..." is ad-hoc, it is not a part of SMP protocol

@@ -207,14 +224,14 @@ testDuplex (ATransport t) =
      ["reply_id", bId] <- return $ B.words msg2
      (bId, encode bSnd) #== "reply queue ID received from Bob"

-      (asPub, asKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-      Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, cmdSEND $ "key " <> C.serializeKey asPub)
+      (asPub, asKey) <- C.generateKeyPair rsaKeySize
+      Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, cmdSEND $ "key " <> C.serializePubKey asPub)
      -- "key ..." is ad-hoc, different from SMP protocol

      Resp "" _ (MSG _ _ msg3) <- tGet fromServer bob
      Resp "abcd" _ OK <- signSendRecv bob brKey ("abcd", bRcv, "ACK")
      ["key", aliceKey] <- return $ B.words msg3
-      (aliceKey, C.serializeKey asPub) #== "key received from Alice"
+      (aliceKey, C.serializePubKey asPub) #== "key received from Alice"
      Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, "KEY " <> aliceKey)

      Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, "SEND 8 hi alice ")
@@ -233,8 +250,8 @@ testSwitchSub :: ATransport -> Spec
 testSwitchSub (ATransport t) =
  it "should create simplex connections and switch subscription to another TCP connection" $
    smpTest3 t $ \rh1 rh2 sh -> do
-      (rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-      Resp "abcd" _ (IDS rId sId) <- signSendRecv rh1 rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
+      (rPub, rKey) <- C.generateKeyPair rsaKeySize
+      Resp "abcd" _ (IDS rId sId) <- signSendRecv rh1 rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
      Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, "SEND 5 test1 ")
      (ok1, OK) #== "sent test message 1"
      Resp "cdab" _ ok2 <- sendRecv sh ("", "cdab", sId, cmdSEND "test2, no ACK")
@@ -270,22 +287,16 @@ testSwitchSub (ATransport t) =
 testWithStoreLog :: ATransport -> Spec
 testWithStoreLog at@(ATransport t) =
  it "should store simplex queues to log and restore them after server restart" $ do
-    (sPub1, sKey1) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-    (sPub2, sKey2) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-    (nPub, nKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
+    (sPub1, sKey1) <- C.generateKeyPair rsaKeySize
+    (sPub2, sKey2) <- C.generateKeyPair rsaKeySize
    senderId1 <- newTVarIO ""
    senderId2 <- newTVarIO ""
-    notifierId <- newTVarIO ""

-    withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
-      (sId1, rId, rKey) <- createAndSecureQueue h sPub1
+    withSmpServerStoreLogOn at testPort . runTest t $ \h -> do
+      (sId1, _, _) <- createAndSecureQueue h sPub1
      atomically $ writeTVar senderId1 sId1
-      Resp "abcd" _ (NID nId) <- signSendRecv h rKey ("abcd", rId, "NKEY " <> C.serializeKey nPub)
-      atomically $ writeTVar notifierId nId
-      Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, "NSUB")
      Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ")
      Resp "" _ (MSG _ _ "hello") <- tGet fromServer h
-      Resp "" _ NMSG <- tGet fromServer h1

      (sId2, rId2, rKey2) <- createAndSecureQueue h sPub2
      atomically $ writeTVar senderId2 sId2
@@ -295,7 +306,7 @@ testWithStoreLog at@(ATransport t) =
      Resp "dabc" _ OK <- signSendRecv h rKey2 ("dabc", rId2, "DEL")
      pure ()

-    logSize `shouldReturn` 6
+    logSize `shouldReturn` 5

    withSmpServerThreadOn at testPort . runTest t $ \h -> do
      sId1 <- readTVarIO senderId1
@@ -303,12 +314,10 @@ testWithStoreLog at@(ATransport t) =
      Resp "bcda" _ (ERR AUTH) <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ")
      pure ()

-    withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
+    withSmpServerStoreLogOn at testPort . runTest t $ \h -> do
      -- this queue is restored
      sId1 <- readTVarIO senderId1
-      nId <- readTVarIO notifierId
      Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ")
-      Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, "NSUB")
      -- this queue is removed - not restored
      sId2 <- readTVarIO senderId2
      Resp "cdab" _ (ERR AUTH) <- signSendRecv h sKey2 ("cdab", sId2, "SEND 9 hello too ")
@@ -317,139 +326,87 @@ testWithStoreLog at@(ATransport t) =
    logSize `shouldReturn` 1
    removeFile testStoreLogFile
  where
+    createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.SafePrivateKey)
+    createAndSecureQueue h sPub = do
+      (rPub, rKey) <- C.generateKeyPair rsaKeySize
+      Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
+      let keyCmd = "KEY " <> C.serializePubKey sPub
+      Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, keyCmd)
+      (rId', rId) #== "same queue ID"
+      pure (sId, rId, rKey)
+
    runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation
    runTest _ test' server = do
      testSMPClient test' `shouldReturn` ()
      killThread server

-    runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
-    runClient _ test' = testSMPClient test' `shouldReturn` ()
-
    logSize :: IO Int
    logSize =
      try (length . B.lines <$> B.readFile testStoreLogFile) >>= \case
        Right l -> pure l
        Left (_ :: SomeException) -> logSize

-createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.APrivateSignKey)
-createAndSecureQueue h sPub = do
-  (rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-  Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
-  let keyCmd = "KEY " <> C.serializeKey sPub
-  Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, keyCmd)
-  (rId', rId) #== "same queue ID"
-  pure (sId, rId, rKey)
-
 testTiming :: ATransport -> Spec
 testTiming (ATransport t) =
  it "should have similar time for auth error, whether queue exists or not, for all key sizes" $
    smpTest2 t $ \rh sh ->
      mapM_
        (testSameTiming rh sh)
-        [ (32, 32, 200),
-          (32, 57, 100),
-          (32, 128, 40),
-          (32, 256, 20),
-          (57, 32, 200),
-          (57, 57, 100),
-          (57, 128, 40),
-          (57, 256, 20),
-          (128, 32, 200),
-          (128, 57, 100),
-          (128, 128, 40),
-          (128, 256, 20),
-          (256, 32, 200),
-          (256, 57, 100),
-          (256, 128, 40),
-          (256, 256, 20)
-          -- (256, 384, 15),
-          -- (256, 512, 10),
-          -- (384, 128, 40),
-          -- (384, 256, 20),
-          -- (384, 384, 15),
-          -- (384, 512, 10),
-          -- (512, 128, 40),
-          -- (512, 256, 20),
+        [ (128, 128, 100),
+          (128, 256, 25),
+          (128, 384, 15),
+          -- (128, 512, 15),
+          (256, 128, 100),
+          (256, 256, 25),
+          (256, 384, 15),
+          -- (256, 512, 15),
+          (384, 128, 100),
+          (384, 256, 25),
+          (384, 384, 15)
+          -- (384, 512, 15),
+          -- (512, 128, 100),
+          -- (512, 256, 25),
          -- (512, 384, 15),
-          -- (512, 512, 10)
+          -- (512, 512, 15)
        ]
  where
    timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
-    similarTime t1 t2 = abs (t2 / t1 - 1) < 0.25 `shouldBe` True
+    similarTime t1 t2 = abs (t1 - t2) / t1 < 0.2 `shouldBe` True
    testSameTiming :: Transport c => THandle c -> THandle c -> (Int, Int, Int) -> Expectation
-    testSameTiming rh sh (goodKeySize, badKeySize, n) = do
-      (rPub, rKey) <- generateKeys goodKeySize
-      Resp "abcd" "" (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializeKey rPub)
-      Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, "SUB")
+    testSameTiming rh sh (senderKeySize, badKeySize, n) = do
+      (rPub, rKey) <- C.generateKeyPair rsaKeySize
+      Resp "abcd" "" (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)

-      (_, badKey) <- generateKeys badKeySize
-      -- runTimingTest rh badKey rId "SUB"
-
-      (sPub, sKey) <- generateKeys goodKeySize
-      let keyCmd = "KEY " <> C.serializeKey sPub
+      (sPub, sKey) <- C.generateKeyPair senderKeySize
+      let keyCmd = "KEY " <> C.serializePubKey sPub
      Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, keyCmd)

+      (_, badKey) <- C.generateKeyPair badKeySize
      Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, "SEND 5 hello ")
+      timeWrongKey <- timeRepeat n $ do
+        Resp "cdab" _ (ERR AUTH) <- signSendRecv sh badKey ("cdab", sId, "SEND 5 hello ")
+        return ()
+      timeNoQueue <- timeRepeat n $ do
+        Resp "dabc" _ (ERR AUTH) <- signSendRecv sh badKey ("dabc", "1234", "SEND 5 hello ")
+        return ()
      Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh
-      runTimingTest sh badKey sId "SEND 5 hello "
-      where
-        generateKeys = \case
-          32 -> C.generateSignatureKeyPair 0 C.SEd25519
-          57 -> C.generateSignatureKeyPair 0 C.SEd448
-          size -> C.generateSignatureKeyPair size C.SRSA
-        runTimingTest h badKey qId cmd = do
-          timeWrongKey <- timeRepeat n $ do
-            Resp "cdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdab", qId, cmd)
-            return ()
-          timeNoQueue <- timeRepeat n $ do
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", "1234", cmd)
-            return ()
-          -- (putStrLn . unwords . map show)
-          --   [ fromIntegral goodKeySize,
-          --     fromIntegral badKeySize,
-          --     timeWrongKey,
-          --     timeNoQueue,
-          --     timeWrongKey / timeNoQueue - 1
-          --   ]
-          similarTime timeNoQueue timeWrongKey
-
-testMessageNotifications :: ATransport -> Spec
-testMessageNotifications (ATransport t) =
-  it "should create simplex connection, subscribe notifier and deliver notifications" $ do
-    (sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-    (nPub, nKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA
-    smpTest4 t $ \rh sh nh1 nh2 -> do
-      (sId, rId, rKey) <- createAndSecureQueue rh sPub
-      Resp "1" _ (NID nId) <- signSendRecv rh rKey ("1", rId, "NKEY " <> C.serializeKey nPub)
-      Resp "2" _ OK <- signSendRecv nh1 nKey ("2", nId, "NSUB")
-      Resp "3" _ OK <- signSendRecv sh sKey ("3", sId, "SEND 5 hello ")
-      Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh
-      Resp "3a" _ OK <- signSendRecv rh rKey ("3a", rId, "ACK")
-      Resp "" _ NMSG <- tGet fromServer nh1
-      Resp "4" _ OK <- signSendRecv nh2 nKey ("4", nId, "NSUB")
-      Resp "" _ END <- tGet fromServer nh1
-      Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, "SEND 11 hello again ")
-      Resp "" _ (MSG _ _ "hello again") <- tGet fromServer rh
-      Resp "" _ NMSG <- tGet fromServer nh2
-      1000 `timeout` tGet fromServer nh1 >>= \case
-        Nothing -> return ()
-        Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection"
+      similarTime timeNoQueue timeWrongKey

 samplePubKey :: ByteString
 samplePubKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"

-sampleSig :: Maybe C.ASignature
-sampleSig = "gM8qn2Vx3GkhIp2hgrji9uhfXKpgtKDmc0maxdP8GvbORUxMCTlLG8Q/gNcl3pQVOzmbZqTZZfKcGDn9DaquJ3fT5D/NKdeW//d6ETE1EXsIbpENS0QsS+bKZDjpp3w3eQlfUxn4BNisp2S14CmJBm/FaiNj2fPkLqfkzZALcoY="
+sampleSig :: ByteString
+sampleSig = "\128\207*\159eq\220i!\"\157\161\130\184\226\246\232_\\\170`\180\160\230sI\154\197\211\252\SUB\246\206ELL\t9K\ESC\196?\128\215%\222\148\NAK;9\155f\164\217e\242\156\CAN9\253\r\170\174'w\211\228?\205)\215\150\255\247z\DC115\DC1{\bn\145\rKD,K\230\202d8\233\167|7y\t_S\EM\248\EOT\216\172\167d\181\224)\137\ACKo\197j#c\217\243\228.\167\228\205\144\vr\134"

 syntaxTests :: ATransport -> Spec
 syntaxTests (ATransport t) = do
  it "unknown command" $ ("", "abcd", "1234", "HELLO") >#> ("", "abcd", "1234", "ERR CMD SYNTAX")
-  describe "NEW" $ do
+  describe "NEW" do
    it "no parameters" $ (sampleSig, "bcda", "", "NEW") >#> ("", "bcda", "", "ERR CMD SYNTAX")
    it "many parameters" $ (sampleSig, "cdab", "", "NEW 1 " <> samplePubKey) >#> ("", "cdab", "", "ERR CMD SYNTAX")
    it "no signature" $ ("", "dabc", "", "NEW " <> samplePubKey) >#> ("", "dabc", "", "ERR CMD NO_AUTH")
    it "queue ID" $ (sampleSig, "abcd", "12345678", "NEW " <> samplePubKey) >#> ("", "abcd", "12345678", "ERR CMD HAS_AUTH")
-  describe "KEY" $ do
+  describe "KEY" do
    it "valid syntax" $ (sampleSig, "bcda", "12345678", "KEY " <> samplePubKey) >#> ("", "bcda", "12345678", "ERR AUTH")
    it "no parameters" $ (sampleSig, "cdab", "12345678", "KEY") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX")
    it "many parameters" $ (sampleSig, "dabc", "12345678", "KEY 1 " <> samplePubKey) >#> ("", "dabc", "12345678", "ERR CMD SYNTAX")
@@ -459,7 +416,7 @@ syntaxTests (ATransport t) = do
  noParamsSyntaxTest "ACK"
  noParamsSyntaxTest "OFF"
  noParamsSyntaxTest "DEL"
-  describe "SEND" $ do
+  describe "SEND" do
    it "valid syntax 1" $ (sampleSig, "cdab", "12345678", "SEND 5 hello ") >#> ("", "cdab", "12345678", "ERR AUTH")
    it "valid syntax 2" $ (sampleSig, "dabc", "12345678", "SEND 11 hello there ") >#> ("", "dabc", "12345678", "ERR AUTH")
    it "no parameters" $ (sampleSig, "abcd", "12345678", "SEND") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX")
@@ -467,16 +424,16 @@ syntaxTests (ATransport t) = do
    it "bad message body 1" $ (sampleSig, "cdab", "12345678", "SEND 11 hello ") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX")
    it "bad message body 2" $ (sampleSig, "dabc", "12345678", "SEND hello ") >#> ("", "dabc", "12345678", "ERR CMD SYNTAX")
    it "bigger body" $ (sampleSig, "abcd", "12345678", "SEND 4 hello ") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX")
-  describe "PING" $ do
+  describe "PING" do
    it "valid syntax" $ ("", "abcd", "", "PING") >#> ("", "abcd", "", "PONG")
-  describe "broker response not allowed" $ do
+  describe "broker response not allowed" do
    it "OK" $ (sampleSig, "bcda", "12345678", "OK") >#> ("", "bcda", "12345678", "ERR CMD PROHIBITED")
  where
    noParamsSyntaxTest :: ByteString -> Spec
-    noParamsSyntaxTest cmd = describe (B.unpack cmd) $ do
+    noParamsSyntaxTest cmd = describe (B.unpack cmd) do
      it "valid syntax" $ (sampleSig, "abcd", "12345678", cmd) >#> ("", "abcd", "12345678", "ERR AUTH")
      it "wrong terminator" $ (sampleSig, "bcda", "12345678", cmd <> "=") >#> ("", "bcda", "12345678", "ERR CMD SYNTAX")
      it "no signature" $ ("", "cdab", "12345678", cmd) >#> ("", "cdab", "12345678", "ERR CMD NO_AUTH")
      it "no queue ID" $ (sampleSig, "dabc", "", cmd) >#> ("", "dabc", "", "ERR CMD NO_AUTH")
-    (>#>) :: SignedRawTransmission -> SignedRawTransmission -> Expectation
+    (>#>) :: RawTransmission -> RawTransmission -> Expectation
    command >#> response = smpServerTest t command `shouldReturn` response
Author	SHA1	Message	Date
Evgeny Poberezkin	091fbdd0e9	rename simplexmq-legacy into simplexmq-v0 (#270 ) * rename simplexmq-legacy into simplexmq-v0 * split UnliftIO instance of ExceptT	2022-01-11 07:27:30 +00:00
Evgeny Poberezkin	8e4c9634e9	update to use legacy name	2022-01-08 10:13:21 +00:00
Evgeny Poberezkin	e237c97d6e	legacy package name: simplexmq-legacy	2022-01-08 10:03:27 +00:00
Evgeny Poberezkin	dd4ccce1ba	0.5.2	2022-01-06 13:52:54 +00:00
Evgeny Poberezkin	584f230c4d	update versions for 0.5.2, changelog (#261 )	2022-01-06 13:50:50 +00:00
Evgeny Poberezkin	10c62e7fa2	fix message delivery when quota exceeded - making it concurrent per queue, not per server (#260 ) * test: HELLO blocking message delivery on the same server * test: quota exceeded in one queue should not block delivery in other queues * fix test to work in stable branch * simplify pending message delivery (#202) * simplify pending message delivery (WIP) * refactor * fix concurrent message delivery * remove type synonym	2022-01-06 08:56:19 +00:00
Evgeny Poberezkin	bd2e251cae	server update script	2021-12-17 13:23:37 +00:00
Evgeny Poberezkin	6b5cc3d2d5	0.5.1	2021-12-17 12:33:01 +00:00
Evgeny PoberezkinandEfim Poberezkin	5f7fe8b0dc	remove client from servers subscribers map after client disconnection (#228 ) Co-authored-by: Efim Poberezkin <[email protected]>	2021-12-17 16:28:48 +04:00