From f060914ab82cddd40f82b4225aac24292cb4c12b Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Tue, 22 Mar 2022 16:18:16 +0000
Subject: [PATCH 01/12] notifications server rfc/schema (#332)

* notifications server rfc/schema

* update schema/protocol
---
 protocol/simplex-uri-request.txt              |  4 +-
 protocol/smp-uri-request.txt                  |  2 +-
 rfcs/2022-03-22-nofication-server.md          | 91 +++++++++++++++++++
 simplexmq.cabal                               |  1 +
 .../Agent/Store/SQLite/Migrations.hs          |  4 +-
 .../Migrations/M20220322_notifications.hs     | 46 ++++++++++
 6 files changed, 144 insertions(+), 4 deletions(-)
 create mode 100644 rfcs/2022-03-22-nofication-server.md
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs

diff --git a/protocol/simplex-uri-request.txt b/protocol/simplex-uri-request.txt
index 968757398..510377cbb 100644
--- a/protocol/simplex-uri-request.txt
+++ b/protocol/simplex-uri-request.txt
@@ -13,6 +13,6 @@ Change controller: Evgeny Poberezkin <ep@simplex.chat>
 
 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
+https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#connection-request
 SimpleX Messaging Protocol:
-https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md
+https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
diff --git a/protocol/smp-uri-request.txt b/protocol/smp-uri-request.txt
index ffa3fd263..d924ad9f1 100644
--- a/protocol/smp-uri-request.txt
+++ b/protocol/smp-uri-request.txt
@@ -13,4 +13,4 @@ Change controller: Evgeny Poberezkin <ep@simplex.chat>
 
 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
+https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#smp-queue-uri
diff --git a/rfcs/2022-03-22-nofication-server.md b/rfcs/2022-03-22-nofication-server.md
new file mode 100644
index 000000000..eebb94861
--- /dev/null
+++ b/rfcs/2022-03-22-nofication-server.md
@@ -0,0 +1,91 @@
+# Notification server
+
+## Background and motivation
+
+SimpleX Chat clients should receive message notifications when not being online and/or subscribed to SMP servers.
+
+To avoid revealing identities of clients directly to SMP servers via any kind of push notification tokens, a new party called SimpleX Notification Server is introduced to act as a service for subscribing to SMP server queue notifications on behalf of clients and sending push notifications to them.
+
+## Proposal
+
+TCP service using the same TLS transport as SMP server, with the fixed size blocks (256 bytes?) and the following set of commands:
+
+### Protocol
+
+#### Create subscription
+
+Command:
+
+`%s"CREATE " ntfSmpQueueURI ntfPrivateKey token subPublicKey`
+
+Response:
+
+`s%"OK"`
+
+#### Check subscription status
+
+Command:
+
+`%s"CHECK " ntfSmpQueueURI`
+
+Response:
+
+```abnf
+statusResp = %s"STAT " status
+status = %s"ERR AUTH" / "ERR SMP AUTH" / %s"ERR SMP TIMEOUT" / %s"ACTIVE" / %s"PENDING"
+```
+
+#### Update subscription device token
+
+Command:
+
+`%s"TOKEN " ntfSmpQueueURI token`
+
+Response:
+
+`s%"OK" / %s"ERR"`
+
+#### Delete subscription (e.g. when deleting the queue or moving to another notification server)
+
+Command:
+
+`%s"DELETE " SP ntfSmpQueueURI`
+
+Response:
+
+`s%"OK" / %s"ERR"`
+
+### Agent schema changes
+
+See [migration](../src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs)
+
+### Agent code
+
+```haskell
+data NtfOptions = NtfOptions
+  { ntfServer :: Server, -- same type as for SMP servers, probably will be renamed
+    ntfToken :: ByteString,
+    ntfInitialCheckDelay :: Int, -- initial check delay after subscription is created, seconds
+    ntfPeriodicCheckInterval :: Int -- subscription check interval, seconds
+  }
+
+data AgentConfig = AgentConfig {
+  -- ...
+  initialNtfOpts :: Maybe NtfOptions
+  -- ...
+  }
+
+data AgentClient = AgentClient {
+  -- ...
+  ntfOpts :: TVar (Maybe NtfOptions)
+  -- ...
+  }
+```
+
+A configuration parameter `initialNtfOpts :: Maybe NtfOptions` - if it is set or changes the agent would automatically manage subscriptions as SMP queues are subscribed/created/deleted and as the token or server changes.
+
+There will be a method to update notifications configuration in case token or server changes.
+
+All subscriptions will be managed in a separate subscription management loop, that would always take the earliest un-updated subscription that requires some action (ntf_sub_action column) and perform this action - the table of subscription would serve both as the table of existing subscriptions and required actions.
+
+E.g. if the queue is subscribed and there is no notification subscription, it will be created in the table with "create" action, and the loop would create it and schedule "check" action on it.
\ No newline at end of file
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 5762c6271..4954ca43a 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -41,6 +41,7 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
       Simplex.Messaging.Client
       Simplex.Messaging.Crypto
       Simplex.Messaging.Crypto.Ratchet
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index 96891bc52..7e7f9f5b4 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -26,6 +26,7 @@ import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
 
 data Migration = Migration {name :: String, up :: Text}
   deriving (Show)
@@ -33,7 +34,8 @@ data Migration = Migration {name :: String, up :: Text}
 schemaMigrations :: [(String, Query)]
 schemaMigrations =
   [ ("20220101_initial", m20220101_initial),
-    ("20220301_snd_queue_keys", m20220301_snd_queue_keys)
+    ("20220301_snd_queue_keys", m20220301_snd_queue_keys),
+    ("20220322_notifications", m20220322_notifications)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
new file mode 100644
index 000000000..5ae493a21
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220322_notifications :: Query
+m20220322_notifications =
+  [sql|
+ALTER TABLE rcv_queues ADD COLUMN ntf_id BLOB;
+
+ALTER TABLE rcv_queues ADD COLUMN ntf_public_key BLOB;
+
+ALTER TABLE rcv_queues ADD COLUMN ntf_private_key BLOB;
+
+CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues (host, port, ntf_id);
+
+CREATE TABLE ntf_servers (
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_key_hash BLOB NOT NULL,
+  created_at TEXT NOT NULL,
+  updated_at TEXT NOT NULL,
+  PRIMARY KEY (ntf_host, ntf_port)
+) WITHOUT ROWID;
+
+CREATE TABLE ntf_subscriptions (
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_sub_status TEXT NOT NULL, -- new, created, active, pending, error_auth
+  ntf_sub_action TEXT, -- if there is an action required on this subscription: create / check / token / delete
+  ntf_sub_action_ts TEXT, -- the earliest time for the action, e.g. checks can be scheduled every X hours
+  ntf_token TEXT NOT NULL, -- or BLOB?
+  smp_host TEXT NOT NULL,
+  smp_port TEXT NOT NULL,
+  smp_ntf_id BLOB NOT NULL,
+  created_at TEXT NOT NULL,
+  updated_at TEXT NOT NULL, -- this is to check subscription status periodically to know when it was last checked
+  PRIMARY KEY (ntf_host, ntf_port, smp_host, smp_port, smp_ntf_id),
+  FOREIGN KEY (ntf_host, ntf_port) REFERENCES ntf_servers
+    ON DELETE RESTRICT ON UPDATE CASCADE,
+  FOREIGN KEY (smp_host, smp_port, smp_ntf_id) REFERENCES rcv_queues (host, port, ntf_id)
+    ON DELETE RESTRICT ON UPDATE CASCADE
+) WITHOUT ROWID;
+|]

From f466fa76e5cde0ecdb029e1c317e761d73ec70b8 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 27 Mar 2022 08:36:00 +0100
Subject: [PATCH 02/12] notifications: protocol, server (#335)

* notifications: protocol

* update protocol to include subscription ID and DH public key

* update protocol, started server

* add notification server subscription DH key

* use the same command type in notifications protocol, protocol parsing, server frame

* remove empty files
---
 protocol/simplex-messaging.md                 |   2 +-
 simplexmq.cabal                               |   7 +
 src/Simplex/Messaging/Agent/Protocol.hs       |   1 -
 .../Migrations/M20220322_notifications.hs     |   3 +-
 src/Simplex/Messaging/Client.hs               |   6 +-
 src/Simplex/Messaging/Crypto.hs               |   6 +
 src/Simplex/Messaging/Encoding.hs             |   4 +
 .../Messaging/Notifications/Protocol.hs       | 161 ++++++++++++++++++
 src/Simplex/Messaging/Notifications/Server.hs | 111 ++++++++++++
 .../Messaging/Notifications/Server/Env.hs     |  66 +++++++
 .../Notifications/Server/Subscriptions.hs     |  25 +++
 .../Messaging/Notifications/Transport.hs      |  19 +++
 src/Simplex/Messaging/Protocol.hs             |  33 ++--
 src/Simplex/Messaging/Server.hs               |  25 +--
 src/Simplex/Messaging/Transport.hs            |  39 +++--
 src/Simplex/Messaging/Transport/Client.hs     |   2 +-
 src/Simplex/Messaging/Transport/Server.hs     |   2 +-
 tests/SMPClient.hs                            |   2 +-
 tests/ServerTests.hs                          |   2 +-
 19 files changed, 460 insertions(+), 56 deletions(-)
 create mode 100644 src/Simplex/Messaging/Notifications/Protocol.hs
 create mode 100644 src/Simplex/Messaging/Notifications/Server.hs
 create mode 100644 src/Simplex/Messaging/Notifications/Server/Env.hs
 create mode 100644 src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
 create mode 100644 src/Simplex/Messaging/Notifications/Transport.hs

diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md
index f24a1dee5..ecd108094 100644
--- a/protocol/simplex-messaging.md
+++ b/protocol/simplex-messaging.md
@@ -770,7 +770,7 @@ The syntax for error responses:
 ```abnf
 error = %s"ERR " errorType
 errorType = %s"BLOCK" / %s"SESSION" / %s"CMD " cmdError / %s"AUTH" / %s"LARGE_MSG" /%s"INTERNAL"
-cmdError = %s"SYNTAX" / %s"PROHIBITED" / %s"NO_AUTH" / %s"HAS_AUTH" / %s"NO_QUEUE"
+cmdError = %s"SYNTAX" / %s"PROHIBITED" / %s"NO_AUTH" / %s"HAS_AUTH" / %s"NO_ENTITY"
 ```
 
 Server implementations must aim to respond within the same time for each command in all cases when `"ERR AUTH"` response is required to prevent timing attacks (e.g., the server should perform signature verification even when the queue does not exist on the server or the signature of different size is sent, using any RSA key with the same size as the signature size).
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 4954ca43a..fa8cfb729 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -47,6 +47,13 @@ library
       Simplex.Messaging.Crypto.Ratchet
       Simplex.Messaging.Encoding
       Simplex.Messaging.Encoding.String
+      Simplex.Messaging.Notifications.Client
+      Simplex.Messaging.Notifications.Client.Env
+      Simplex.Messaging.Notifications.Protocol
+      Simplex.Messaging.Notifications.Server
+      Simplex.Messaging.Notifications.Server.Env
+      Simplex.Messaging.Notifications.Server.Subscriptions
+      Simplex.Messaging.Notifications.Transport
       Simplex.Messaging.Parsers
       Simplex.Messaging.Protocol
       Simplex.Messaging.Server
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index b38410d1e..fa1d46a8a 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -539,7 +539,6 @@ data SMPQueueUri = SMPQueueUri
   }
   deriving (Eq, Show)
 
--- TODO change SMP queue URI format to include version range and allow unknown parameters
 instance StrEncoding SMPQueueUri where
   -- v1 uses short SMP queue URI format
   strEncode SMPQueueUri {smpServer = srv, senderId = qId, clientVRange = _vr, dhPublicKey = k} =
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
index 5ae493a21..8fd996810 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
@@ -28,6 +28,7 @@ CREATE TABLE ntf_servers (
 CREATE TABLE ntf_subscriptions (
   ntf_host TEXT NOT NULL,
   ntf_port TEXT NOT NULL,
+  ntf_sub_id BLOB NOT NULL,
   ntf_sub_status TEXT NOT NULL, -- new, created, active, pending, error_auth
   ntf_sub_action TEXT, -- if there is an action required on this subscription: create / check / token / delete
   ntf_sub_action_ts TEXT, -- the earliest time for the action, e.g. checks can be scheduled every X hours
@@ -37,7 +38,7 @@ CREATE TABLE ntf_subscriptions (
   smp_ntf_id BLOB NOT NULL,
   created_at TEXT NOT NULL,
   updated_at TEXT NOT NULL, -- this is to check subscription status periodically to know when it was last checked
-  PRIMARY KEY (ntf_host, ntf_port, smp_host, smp_port, smp_ntf_id),
+  PRIMARY KEY (ntf_host, ntf_port, ntf_sub_id),
   FOREIGN KEY (ntf_host, ntf_port) REFERENCES ntf_servers
     ON DELETE RESTRICT ON UPDATE CASCADE,
   FOREIGN KEY (smp_host, smp_port, smp_ntf_id) REFERENCES rcv_queues (host, port, ntf_id)
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index e6e87337f..f91a0100a 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -63,8 +63,8 @@ import Network.Socket (ServiceName)
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake)
-import Simplex.Messaging.Transport.Client (runTransportClient)
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError)
+import Simplex.Messaging.Transport.Client (runTransportClient, smpClientHandshake)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
@@ -175,7 +175,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smp
 
     client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError (THandle c)) -> c -> IO ()
     client _ c thVar h =
-      runExceptT (clientHandshake h $ keyHash smpServer) >>= \case
+      runExceptT (smpClientHandshake h $ keyHash smpServer) >>= \case
         Left e -> atomically . putTMVar thVar . Left $ SMPTransportError e
         Right th@THandle {sessionId} -> do
           atomically $ do
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 669792476..92ff4f75e 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -284,6 +284,12 @@ instance Eq APrivateSignKey where
 
 deriving instance Show APrivateSignKey
 
+instance Encoding APrivateSignKey where
+  smpEncode = smpEncode . encodePrivKey
+  {-# INLINE smpEncode #-}
+  smpDecode = decodePrivKey
+  {-# INLINE smpDecode #-}
+
 data APublicVerifyKey
   = forall a.
     (AlgorithmI a, SignatureAlgorithm a) =>
diff --git a/src/Simplex/Messaging/Encoding.hs b/src/Simplex/Messaging/Encoding.hs
index a0abca35e..6c7c56ddd 100644
--- a/src/Simplex/Messaging/Encoding.hs
+++ b/src/Simplex/Messaging/Encoding.hs
@@ -141,3 +141,7 @@ instance (Encoding a, Encoding b, Encoding c, Encoding d) => Encoding (a, b, c,
 instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e) => Encoding (a, b, c, d, e) where
   smpEncode (a, b, c, d, e) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d <> smpEncode e
   smpP = (,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP
+
+instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f) => Encoding (a, b, c, d, e, f) where
+  smpEncode (a, b, c, d, e, f) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d <> smpEncode e <> smpEncode f
+  smpP = (,,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
new file mode 100644
index 000000000..da66280fd
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -0,0 +1,161 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Simplex.Messaging.Notifications.Protocol where
+
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Maybe (isNothing)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Protocol
+
+data NtfCommandTag
+  = NCCreate_
+  | NCCheck_
+  | NCToken_
+  | NCDelete_
+  deriving (Show)
+
+instance Encoding NtfCommandTag where
+  smpEncode = \case
+    NCCreate_ -> "CREATE"
+    NCCheck_ -> "CHECK"
+    NCToken_ -> "TOKEN"
+    NCDelete_ -> "DELETE"
+  smpP = messageTagP
+
+instance ProtocolMsgTag NtfCommandTag where
+  decodeTag = \case
+    "CREATE" -> Just NCCreate_
+    "CHECK" -> Just NCCheck_
+    "TOKEN" -> Just NCToken_
+    "DELETE" -> Just NCDelete_
+    _ -> Nothing
+
+data NtfCommand
+  = NCCreate DeviceToken SMPQueueNtfUri C.APublicVerifyKey C.PublicKeyX25519
+  | NCCheck
+  | NCToken DeviceToken
+  | NCDelete
+
+instance Protocol NtfCommand where
+  type Tag NtfCommand = NtfCommandTag
+  encodeProtocol = \case
+    NCCreate token smpQueue verifyKey dhKey -> e (NCCreate_, ' ', token, smpQueue, verifyKey, dhKey)
+    NCCheck -> e NCCheck_
+    NCToken token -> e (NCToken_, ' ', token)
+    NCDelete -> e NCDelete_
+    where
+      e :: Encoding a => a -> ByteString
+      e = smpEncode
+
+  protocolP = \case
+    NCCreate_ -> NCCreate <$> _smpP <*> smpP <*> smpP <*> smpP
+    NCCheck_ -> pure NCCheck
+    NCToken_ -> NCToken <$> _smpP
+    NCDelete_ -> pure NCDelete
+
+  checkCredentials (sig, _, subId, _) cmd = case cmd of
+    -- CREATE must have signature but NOT subscription ID
+    NCCreate {}
+      | isNothing sig -> Left $ CMD NO_AUTH
+      | not (B.null subId) -> Left $ CMD HAS_AUTH
+      | otherwise -> Right cmd
+    -- other client commands must have both signature and subscription ID
+    _
+      | isNothing sig || B.null subId -> Left $ CMD NO_AUTH
+      | otherwise -> Right cmd
+
+data NtfResponseTag
+  = NRSubId_
+  | NROk_
+  | NRErr_
+  | NRStat_
+  deriving (Show)
+
+instance Encoding NtfResponseTag where
+  smpEncode = \case
+    NRSubId_ -> "ID"
+    NROk_ -> "OK"
+    NRErr_ -> "ERR"
+    NRStat_ -> "STAT"
+  smpP = messageTagP
+
+instance ProtocolMsgTag NtfResponseTag where
+  decodeTag = \case
+    "ID" -> Just NRSubId_
+    "OK" -> Just NROk_
+    "ERR" -> Just NRErr_
+    "STAT" -> Just NRStat_
+    _ -> Nothing
+
+data NtfResponse
+  = NRSubId C.PublicKeyX25519
+  | NROk
+  | NRErr ErrorType
+  | NRStat NtfStatus
+
+instance Protocol NtfResponse where
+  type Tag NtfResponse = NtfResponseTag
+  encodeProtocol = \case
+    NRSubId dhKey -> e (NRSubId_, ' ', dhKey)
+    NROk -> e NROk_
+    NRErr err -> e (NRErr_, ' ', err)
+    NRStat stat -> e (NRStat_, ' ', stat)
+    where
+      e :: Encoding a => a -> ByteString
+      e = smpEncode
+
+  protocolP = \case
+    NRSubId_ -> NRSubId <$> _smpP
+    NROk_ -> pure NROk
+    NRErr_ -> NRErr <$> _smpP
+    NRStat_ -> NRStat <$> _smpP
+
+  checkCredentials (_, _, subId, _) cmd = case cmd of
+    -- ERR response does not always have subscription ID
+    NRErr _ -> Right cmd
+    -- other server responses must have subscription ID
+    _
+      | B.null subId -> Left $ CMD NO_ENTITY
+      | otherwise -> Right cmd
+
+data SMPQueueNtfUri = SMPQueueNtfUri
+  { smpServer :: SMPServer,
+    notifierId :: NotifierId,
+    notifierKey :: NtfPrivateSignKey
+  }
+
+instance Encoding SMPQueueNtfUri where
+  smpEncode SMPQueueNtfUri {smpServer, notifierId, notifierKey} = smpEncode (smpServer, notifierId, notifierKey)
+  smpP = do
+    (smpServer, notifierId, notifierKey) <- smpP
+    pure $ SMPQueueNtfUri smpServer notifierId notifierKey
+
+newtype DeviceToken = DeviceToken ByteString
+
+instance Encoding DeviceToken where
+  smpEncode (DeviceToken t) = smpEncode t
+  smpP = DeviceToken <$> smpP
+
+type NtfSubsciptionId = ByteString
+
+data NtfStatus = NSPending | NSActive | NSEnd | NSSMPAuth
+
+instance Encoding NtfStatus where
+  smpEncode = \case
+    NSPending -> "PENDING"
+    NSActive -> "ACTIVE"
+    NSEnd -> "END"
+    NSSMPAuth -> "SMP_AUTH"
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "PENDING" -> pure NSPending
+      "ACTIVE" -> pure NSActive
+      "END" -> pure NSEnd
+      "SMP_AUTH" -> pure NSSMPAuth
+      _ -> fail "bad NtfError"
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
new file mode 100644
index 000000000..dfdaae801
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Notifications.Server where
+
+import Control.Monad.Except
+import Control.Monad.IO.Unlift (MonadUnliftIO)
+import Control.Monad.Reader
+import Crypto.Random (MonadRandom)
+import Data.ByteString.Char8 (ByteString)
+import Network.Socket (ServiceName)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Env
+import Simplex.Messaging.Notifications.Server.Subscriptions
+import Simplex.Messaging.Notifications.Transport
+import Simplex.Messaging.Protocol (ErrorType (..), Transmission, encodeTransmission, tGet, tPut)
+import Simplex.Messaging.Server
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), TProxy, Transport)
+import Simplex.Messaging.Transport.Server (runTransportServer)
+import Simplex.Messaging.Util
+import UnliftIO.Exception
+import UnliftIO.STM
+
+runNtfServer :: (MonadRandom m, MonadUnliftIO m) => NtfServerConfig -> m ()
+runNtfServer cfg = do
+  started <- newEmptyTMVarIO
+  runNtfServerBlocking started cfg
+
+runNtfServerBlocking :: (MonadRandom m, MonadUnliftIO m) => TMVar Bool -> NtfServerConfig -> m ()
+runNtfServerBlocking started cfg@NtfServerConfig {transports} = do
+  env <- newNtfServerEnv cfg
+  runReaderT ntfServer env
+  where
+    ntfServer :: (MonadUnliftIO m', MonadReader NtfEnv m') => m' ()
+    ntfServer = raceAny_ (map runServer transports)
+
+    runServer :: (MonadUnliftIO m', MonadReader NtfEnv m') => (ServiceName, ATransport) -> m' ()
+    runServer (tcpPort, ATransport t) = do
+      serverParams <- asks tlsServerParams
+      runTransportServer started tcpPort serverParams (runClient t)
+
+    runClient :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => TProxy c -> c -> m ()
+    runClient _ h = do
+      kh <- asks serverIdentity
+      liftIO (runExceptT $ ntfServerHandshake h kh) >>= \case
+        Right th -> runNtfClientTransport th
+        Left _ -> pure ()
+
+runNtfClientTransport :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> m ()
+runNtfClientTransport th@THandle {sessionId} = do
+  q <- asks $ tbqSize . config
+  c <- atomically $ newNtfServerClient q sessionId
+  raceAny_ [send th c, client c, receive th c]
+    `finally` clientDisconnected c
+
+clientDisconnected :: MonadUnliftIO m => NtfServerClient -> m ()
+clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connected False
+
+receive :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> NtfServerClient -> m ()
+receive th NtfServerClient {rcvQ, sndQ} = forever $ do
+  (sig, signed, (corrId, queueId, cmdOrError)) <- tGet th
+  case cmdOrError of
+    Left e -> write sndQ (corrId, queueId, NRErr e)
+    Right cmd -> do
+      verified <- verifyTransmission sig signed queueId cmd
+      if verified
+        then write rcvQ (corrId, queueId, cmd)
+        else write sndQ (corrId, queueId, NRErr AUTH)
+  where
+    write q t = atomically $ writeTBQueue q t
+
+send :: (Transport c, MonadUnliftIO m) => THandle c -> NtfServerClient -> m ()
+send h NtfServerClient {sndQ, sessionId} = forever $ do
+  t <- atomically $ readTBQueue sndQ
+  liftIO $ tPut h (Nothing, encodeTransmission sessionId t)
+
+verifyTransmission ::
+  forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => Maybe C.ASignature -> ByteString -> NtfSubsciptionId -> NtfCommand -> m Bool
+verifyTransmission sig_ signed subId cmd = do
+  case cmd of
+    NCCreate _ _ k _ -> pure $ verifyCmdSignature sig_ signed k
+    _ -> do
+      st <- asks store
+      verifySubCmd <$> atomically (getNtfSubscription st subId)
+  where
+    verifySubCmd = \case
+      Right sub -> verifyCmdSignature sig_ signed $ subVerifyKey sub
+      Left _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` False
+
+client :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfServerClient -> m ()
+client NtfServerClient {rcvQ, sndQ} =
+  forever $
+    atomically (readTBQueue rcvQ)
+      >>= processCommand
+      >>= atomically . writeTBQueue sndQ
+  where
+    processCommand :: Transmission NtfCommand -> m (Transmission NtfResponse)
+    processCommand (corrId, subId, cmd) = case cmd of
+      NCCreate _token _smpQueue _verifyKey _dhKey -> do
+        pure (corrId, subId, NROk)
+      NCCheck -> do
+        pure (corrId, subId, NROk)
+      NCToken _token -> do
+        pure (corrId, subId, NROk)
+      NCDelete -> do
+        pure (corrId, subId, NROk)
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
new file mode 100644
index 000000000..3ce4d2b8d
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Notifications.Server.Env where
+
+import Control.Monad.IO.Unlift
+import Crypto.Random
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.Map.Strict as M
+import Data.X509.Validation (Fingerprint (..))
+import Network.Socket
+import qualified Network.TLS as T
+import Numeric.Natural
+import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Client
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Subscriptions
+import Simplex.Messaging.Protocol (Transmission)
+import Simplex.Messaging.Transport (ATransport)
+import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
+import UnliftIO.STM
+
+data NtfServerConfig = NtfServerConfig
+  { transports :: [(ServiceName, ATransport)],
+    subscriptionIdBytes :: Int,
+    tbqSize :: Natural,
+    smpCfg :: SMPClientConfig,
+    reconnectInterval :: RetryInterval,
+    -- CA certificate private key is not needed for initialization
+    caCertificateFile :: FilePath,
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath
+  }
+
+data NtfEnv = NtfEnv
+  { config :: NtfServerConfig,
+    serverIdentity :: C.KeyHash,
+    store :: NtfSubscriptions,
+    idsDrg :: TVar ChaChaDRG,
+    tlsServerParams :: T.ServerParams,
+    serverIdentity :: C.KeyHash
+  }
+
+newNtfServerEnv :: (MonadUnliftIO m, MonadRandom m) => NtfServerConfig -> m NtfEnv
+newNtfServerEnv config@NtfServerConfig {caCertificateFile, certificateFile, privateKeyFile} = do
+  idsDrg <- newTVarIO =<< drgNew
+  store <- newTVarIO M.empty
+  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
+  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
+  let serverIdentity = C.KeyHash fp
+  pure NtfEnv {config, store, idsDrg, tlsServerParams, serverIdentity}
+
+data NtfServerClient = NtfServerClient
+  { rcvQ :: TBQueue (Transmission NtfCommand),
+    sndQ :: TBQueue (Transmission NtfResponse),
+    sessionId :: ByteString,
+    connected :: TVar Bool
+  }
+
+newNtfServerClient :: Natural -> ByteString -> STM NtfServerClient
+newNtfServerClient qSize sessionId = do
+  rcvQ <- newTBQueue qSize
+  sndQ <- newTBQueue qSize
+  connected <- newTVar True
+  return NtfServerClient {rcvQ, sndQ, sessionId, connected}
diff --git a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
new file mode 100644
index 000000000..5658e336a
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
@@ -0,0 +1,25 @@
+module Simplex.Messaging.Notifications.Server.Subscriptions where
+
+import Control.Concurrent.STM
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Protocol (ErrorType (..), NotifierId, NtfPrivateSignKey, SMPServer)
+
+type NtfSubscriptionsData = Map NtfSubsciptionId NtfSubsciptionRec
+
+type NtfSubscriptions = TVar NtfSubscriptionsData
+
+data NtfSubsciptionRec = NtfSubsciptionRec
+  { smpServer :: SMPServer,
+    notifierId :: NotifierId,
+    notifierKey :: NtfPrivateSignKey,
+    token :: DeviceToken,
+    status :: TVar NtfStatus,
+    subVerifyKey :: C.APublicVerifyKey,
+    subDHSecret :: C.DhSecretX25519
+  }
+
+getNtfSubscription :: NtfSubscriptions -> NtfSubsciptionId -> STM (Either ErrorType NtfSubsciptionRec)
+getNtfSubscription st subId = maybe (Left AUTH) Right . M.lookup subId <$> readTVar st
diff --git a/src/Simplex/Messaging/Notifications/Transport.hs b/src/Simplex/Messaging/Notifications/Transport.hs
new file mode 100644
index 000000000..8d9b77b5c
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Transport.hs
@@ -0,0 +1,19 @@
+module Simplex.Messaging.Notifications.Transport where
+
+import Control.Monad.Except
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Transport
+
+ntfBlockSize :: Int
+ntfBlockSize = 512
+
+-- | Notifcations server transport handshake.
+ntfServerHandshake :: Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
+ntfServerHandshake c _ = pure $ ntfTHandle c
+
+-- | Notifcations server client transport handshake.
+ntfClientHandshake :: Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
+ntfClientHandshake c _ = pure $ ntfTHandle c
+
+ntfTHandle :: Transport c => c -> THandle c
+ntfTHandle c = THandle {connection = c, sessionId = tlsUnique c, blockSize = ntfBlockSize, thVersion = 0}
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 0d148bf04..dbe5a98a0 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -37,7 +37,7 @@ module Simplex.Messaging.Protocol
     e2eEncMessageLength,
 
     -- * SMP protocol types
-    Protocol,
+    Protocol (..),
     Command (..),
     Party (..),
     Cmd (..),
@@ -74,9 +74,11 @@ module Simplex.Messaging.Protocol
     MsgBody,
 
     -- * Parse and serialize
+    ProtocolMsgTag (..),
+    messageTagP,
     encodeTransmission,
     transmissionP,
-    encodeProtocol,
+    _smpP,
 
     -- * TCP transport functions
     tPut,
@@ -174,7 +176,7 @@ data RawTransmission = RawTransmission
     signed :: ByteString,
     sessId :: ByteString,
     corrId :: ByteString,
-    queueId :: ByteString,
+    entityId :: ByteString,
     command :: ByteString
   }
 
@@ -512,8 +514,8 @@ data CommandError
     NO_AUTH
   | -- | transmission has credentials that are not allowed for this command
     HAS_AUTH
-  | -- | transmission has no required queue ID
-    NO_QUEUE
+  | -- | transmission has no required entity ID (e.g. SMP queue)
+    NO_ENTITY
   deriving (Eq, Generic, Read, Show)
 
 instance ToJSON CommandError where
@@ -534,9 +536,9 @@ transmissionP = do
     trn signature signed = do
       sessId <- smpP
       corrId <- smpP
-      queueId <- smpP
+      entityId <- smpP
       command <- A.takeByteString
-      pure RawTransmission {signature, signed, sessId, corrId, queueId, command}
+      pure RawTransmission {signature, signed, sessId, corrId, entityId, command}
 
 class Protocol msg where
   type Tag msg
@@ -571,7 +573,7 @@ instance PartyI p => Protocol (Command p) where
       | otherwise -> Right cmd
     -- SEND must have queue ID, signature is not always required
     SEND _
-      | B.null queueId -> Left $ CMD NO_QUEUE
+      | B.null queueId -> Left $ CMD NO_ENTITY
       | otherwise -> Right cmd
     -- PING must not have queue ID or signature
     PING
@@ -640,7 +642,7 @@ instance Protocol BrokerMsg where
       | otherwise -> Left $ CMD HAS_AUTH
     -- other broker responses must have queue ID
     _
-      | B.null queueId -> Left $ CMD NO_QUEUE
+      | B.null queueId -> Left $ CMD NO_ENTITY
       | otherwise -> Right cmd
 
 _smpP :: Encoding a => Parser a
@@ -695,14 +697,15 @@ instance Encoding CommandError where
     SYNTAX -> "SYNTAX"
     NO_AUTH -> "NO_AUTH"
     HAS_AUTH -> "HAS_AUTH"
-    NO_QUEUE -> "NO_QUEUE"
+    NO_ENTITY -> "NO_ENTITY"
   smpP =
     A.takeTill (== ' ') >>= \case
       "UNKNOWN" -> pure UNKNOWN
       "SYNTAX" -> pure SYNTAX
       "NO_AUTH" -> pure NO_AUTH
       "HAS_AUTH" -> pure HAS_AUTH
-      "NO_QUEUE" -> pure NO_QUEUE
+      "NO_ENTITY" -> pure NO_ENTITY
+      "NO_QUEUE" -> pure NO_ENTITY
       _ -> fail "bad command error type"
 
 -- | Send signed SMP transmission to TCP transport.
@@ -727,9 +730,9 @@ tGet th@THandle {sessionId} = liftIO (tGetParse th) >>= decodeParseValidate
   where
     decodeParseValidate :: Either TransportError RawTransmission -> m (SignedTransmission cmd)
     decodeParseValidate = \case
-      Right RawTransmission {signature, signed, sessId, corrId, queueId, command}
+      Right RawTransmission {signature, signed, sessId, corrId, entityId, command}
         | sessId == sessionId ->
-          let decodedTransmission = (,corrId,queueId,command) <$> C.decodeSignature signature
+          let decodedTransmission = (,corrId,entityId,command) <$> C.decodeSignature signature
            in either (const $ tError corrId) (tParseValidate signed) decodedTransmission
         | otherwise -> pure (Nothing, "", (CorrId corrId, "", Left SESSION))
       Left _ -> tError ""
@@ -738,6 +741,6 @@ tGet th@THandle {sessionId} = liftIO (tGetParse th) >>= decodeParseValidate
     tError corrId = pure (Nothing, "", (CorrId corrId, "", Left BLOCK))
 
     tParseValidate :: ByteString -> SignedRawTransmission -> m (SignedTransmission cmd)
-    tParseValidate signed t@(sig, corrId, queueId, command) = do
+    tParseValidate signed t@(sig, corrId, entityId, command) = do
       let cmd = parseProtocol command >>= checkCredentials t
-      pure (sig, signed, (CorrId corrId, queueId, cmd))
+      pure (sig, signed, (CorrId corrId, entityId, cmd))
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 73b5780ef..e913f8b19 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -23,7 +23,7 @@
 -- and optional append only log of SMP queue records.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
-module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking) where
+module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking, verifyCmdSignature, dummyVerifyCmd) where
 
 import Control.Concurrent.STM (stateTVar)
 import Control.Monad
@@ -121,7 +121,7 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do
     runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
     runClient _ h = do
       kh <- asks serverIdentity
-      liftIO (runExceptT $ serverHandshake h kh) >>= \case
+      liftIO (runExceptT $ smpServerHandshake h kh) >>= \case
         Right th -> runClientTransport th
         Left _ -> pure ()
 
@@ -176,8 +176,8 @@ verifyTransmission ::
   forall m. (MonadUnliftIO m, MonadReader Env m) => Maybe C.ASignature -> ByteString -> QueueId -> Cmd -> m Bool
 verifyTransmission sig_ signed queueId cmd = do
   case cmd of
-    Cmd SRecipient (NEW k _) -> pure $ verifySignature k
-    Cmd SRecipient _ -> verifyCmd SRecipient $ verifySignature . recipientKey
+    Cmd SRecipient (NEW k _) -> pure $ verifyCmdSignature sig_ signed k
+    Cmd SRecipient _ -> verifyCmd SRecipient $ verifyCmdSignature sig_ signed . recipientKey
     Cmd SSender (SEND _) -> verifyCmd SSender $ verifyMaybe . senderKey
     Cmd SSender PING -> pure True
     Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe . fmap snd . notifier
@@ -186,18 +186,21 @@ verifyTransmission sig_ signed queueId cmd = do
     verifyCmd party f = do
       st <- asks queueStore
       q <- atomically $ getQueue st party queueId
-      pure $ either (const $ maybe False dummyVerify sig_ `seq` False) f q
+      pure $ either (const $ maybe False (dummyVerifyCmd signed) sig_ `seq` False) f q
     verifyMaybe :: Maybe C.APublicVerifyKey -> Bool
-    verifyMaybe = maybe (isNothing sig_) verifySignature
-    verifySignature :: C.APublicVerifyKey -> Bool
-    verifySignature key = maybe False (verify key) sig_
+    verifyMaybe = maybe (isNothing sig_) $ verifyCmdSignature sig_ signed
+
+verifyCmdSignature :: Maybe C.ASignature -> ByteString -> C.APublicVerifyKey -> Bool
+verifyCmdSignature sig_ signed key = maybe False (verify key) sig_
+  where
     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) -> C.verify' k s signed
-        _ -> dummyVerify sig `seq` False
-    dummyVerify :: C.ASignature -> Bool
-    dummyVerify (C.ASignature _ s) = C.verify' (dummyPublicKey s) s signed
+        _ -> dummyVerifyCmd signed sig `seq` False
+
+dummyVerifyCmd :: ByteString -> C.ASignature -> Bool
+dummyVerifyCmd signed (C.ASignature _ s) = C.verify' (dummyPublicKey s) s signed
 
 -- 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
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 8379c35bd..8686f6499 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -26,7 +26,6 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
 module Simplex.Messaging.Transport
   ( -- * SMP transport parameters
-    smpBlockSize,
     supportedSMPVersions,
     simplexMQVersion,
 
@@ -46,8 +45,8 @@ module Simplex.Messaging.Transport
     -- * SMP transport
     THandle (..),
     TransportError (..),
-    serverHandshake,
-    clientHandshake,
+    smpServerHandshake,
+    smpClientHandshake,
     tPutBlock,
     tGetBlock,
     serializeTransportError,
@@ -251,8 +250,9 @@ trimCR s = if B.last s == '\r' then B.init s else s
 data THandle c = THandle
   { connection :: c,
     sessionId :: ByteString,
-    -- | agreed SMP server protocol version
-    smpVersion :: Version
+    blockSize :: Int,
+    -- | agreed server protocol version
+    thVersion :: Version
   }
 
 data ServerHandshake = ServerHandshake
@@ -332,45 +332,45 @@ serializeTransportError = \case
 
 -- | Pad and send block to SMP transport.
 tPutBlock :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
-tPutBlock THandle {connection = c} block =
+tPutBlock THandle {connection = c, blockSize} block =
   bimapM (const $ pure TELargeMsg) (cPut c) $
-    C.pad block smpBlockSize
+    C.pad block blockSize
 
 -- | Receive block from SMP transport.
 tGetBlock :: Transport c => THandle c -> IO (Either TransportError ByteString)
-tGetBlock THandle {connection = c} =
-  cGet c smpBlockSize >>= \case
+tGetBlock THandle {connection = c, blockSize} =
+  cGet c blockSize >>= \case
     "" -> ioe_EOF
     msg -> pure . first (const TELargeMsg) $ C.unPad msg
 
 -- | Server SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-serverHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
-serverHandshake c kh = do
-  let th@THandle {sessionId} = tHandle c
+smpServerHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
+smpServerHandshake c kh = do
+  let th@THandle {sessionId} = smpTHandle c
   sendHandshake th $ ServerHandshake {sessionId, smpVersionRange = supportedSMPVersions}
   getHandshake th >>= \case
     ClientHandshake {smpVersion, keyHash}
       | keyHash /= kh ->
         throwE $ TEHandshake IDENTITY
       | smpVersion `isCompatible` supportedSMPVersions -> do
-        pure (th :: THandle c) {smpVersion}
+        pure (th :: THandle c) {thVersion = smpVersion}
       | otherwise -> throwE $ TEHandshake VERSION
 
 -- | Client SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-clientHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
-clientHandshake c keyHash = do
-  let th@THandle {sessionId} = tHandle c
+smpClientHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
+smpClientHandshake c keyHash = do
+  let th@THandle {sessionId} = smpTHandle c
   ServerHandshake {sessionId = sessId, smpVersionRange} <- getHandshake th
   if sessionId /= sessId
     then throwE TEBadSession
     else case smpVersionRange `compatibleVersion` supportedSMPVersions of
       Just (Compatible smpVersion) -> do
         sendHandshake th $ ClientHandshake {smpVersion, keyHash}
-        pure (th :: THandle c) {smpVersion}
+        pure (th :: THandle c) {thVersion = smpVersion}
       Nothing -> throwE $ TEHandshake VERSION
 
 sendHandshake :: (Transport c, Encoding smp) => THandle c -> smp -> ExceptT TransportError IO ()
@@ -379,6 +379,5 @@ sendHandshake th = ExceptT . tPutBlock th . smpEncode
 getHandshake :: (Transport c, Encoding smp) => THandle c -> ExceptT TransportError IO smp
 getHandshake th = ExceptT $ (parse smpP (TEHandshake PARSE) =<<) <$> tGetBlock th
 
-tHandle :: Transport c => c -> THandle c
-tHandle c =
-  THandle {connection = c, sessionId = tlsUnique c, smpVersion = 0}
+smpTHandle :: Transport c => c -> THandle c
+smpTHandle c = THandle {connection = c, sessionId = tlsUnique c, blockSize = smpBlockSize, thVersion = 0}
diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs
index e02480200..3771da99e 100644
--- a/src/Simplex/Messaging/Transport/Client.hs
+++ b/src/Simplex/Messaging/Transport/Client.hs
@@ -2,7 +2,7 @@
 
 module Simplex.Messaging.Transport.Client
   ( runTransportClient,
-    clientHandshake,
+    smpClientHandshake,
   )
 where
 
diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs
index d91c596b9..de66f95c8 100644
--- a/src/Simplex/Messaging/Transport/Server.hs
+++ b/src/Simplex/Messaging/Transport/Server.hs
@@ -6,7 +6,7 @@ module Simplex.Messaging.Transport.Server
   ( runTransportServer,
     loadTLSServerParams,
     loadFingerprint,
-    serverHandshake,
+    smpServerHandshake,
   )
 where
 
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 3abf2c4d9..3789647f5 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -47,7 +47,7 @@ testStoreLogFile = "tests/tmp/smp-server-store.log"
 testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
   runTransportClient testHost testPort testKeyHash (Just defaultKeepAliveOpts) $ \h ->
-    liftIO (runExceptT $ clientHandshake h testKeyHash) >>= \case
+    liftIO (runExceptT $ smpClientHandshake h testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e
 
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 418c86a5e..1cbeba083 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -496,7 +496,7 @@ syntaxTests (ATransport t) = do
   describe "SEND" $ do
     it "valid syntax" $ (sampleSig, "cdab", "12345678", (SEND_, ' ', "hello" :: ByteString)) >#> ("", "cdab", "12345678", ERR AUTH)
     it "no parameters" $ (sampleSig, "abcd", "12345678", SEND_) >#> ("", "abcd", "12345678", ERR $ CMD SYNTAX)
-    it "no queue ID" $ (sampleSig, "bcda", "", (SEND_, ' ', "hello" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_QUEUE)
+    it "no queue ID" $ (sampleSig, "bcda", "", (SEND_, ' ', "hello" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_ENTITY)
   describe "PING" $ do
     it "valid syntax" $ ("", "abcd", "", PING_) >#> ("", "abcd", "", PONG)
   describe "broker response not allowed" $ do

From d31958855f7072340136a15dc508e082cfcfecfd Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 2 Apr 2022 16:14:19 +0100
Subject: [PATCH 03/12] ntf server implementation, updated ntf protocol, ntf
 client based on refactored protocol client, bare-bones SMP agent to manage
 ntf connections (to connect to ntf server) (#338)

* process ntf server commands

* when subscription is re-created and it was ENDed, resubscribe to SMP

* SMPClientAgent draft

* SMPClientAgent: remove double tracking of subscriptions

* subscriber frame

* PING error now throws error to restart SMPClient for more reliable re-connection (#342)

* increase TCP timeout to 5 sec

* add pragmas and vacuum db (#343)

* vacuum in each connection to enable auto-vacuum (#344)

* update protocol, token verification

* refactor SMPClient to ProtocoClient, to use with notification server protocol

* notification server client, managing notification clients in the agent

* stub for push payload

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
---
 .../diagrams/notifications/register-token.mmd |  30 ++
 simplexmq.cabal                               |   2 +
 src/Simplex/Messaging/Agent.hs                |  16 +-
 src/Simplex/Messaging/Agent/Client.hs         | 264 ++++++++-------
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   7 +-
 src/Simplex/Messaging/Agent/Protocol.hs       |   7 +-
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  32 +-
 src/Simplex/Messaging/Client.hs               | 209 ++++++------
 src/Simplex/Messaging/Client/Agent.hs         | 301 +++++++++++++++++
 src/Simplex/Messaging/Notifications/Client.hs |  55 +++
 .../Messaging/Notifications/Protocol.hs       | 312 ++++++++++++++----
 src/Simplex/Messaging/Notifications/Server.hs | 218 ++++++++++--
 .../Messaging/Notifications/Server/Env.hs     |  59 +++-
 .../Messaging/Notifications/Server/Push.hs    |  11 +
 .../Notifications/Server/Subscriptions.hs     | 114 ++++++-
 src/Simplex/Messaging/Protocol.hs             |  76 +++--
 src/Simplex/Messaging/Server.hs               |   2 +-
 src/Simplex/Messaging/TMap.hs                 |   7 +
 src/Simplex/Messaging/Transport/KeepAlive.hs  |   2 +-
 tests/AgentTests/ConnectionRequestTests.hs    |   4 +-
 tests/SMPAgentClient.hs                       |   4 +-
 21 files changed, 1337 insertions(+), 395 deletions(-)
 create mode 100644 protocol/diagrams/notifications/register-token.mmd
 create mode 100644 src/Simplex/Messaging/Client/Agent.hs
 create mode 100644 src/Simplex/Messaging/Notifications/Client.hs
 create mode 100644 src/Simplex/Messaging/Notifications/Server/Push.hs

diff --git a/protocol/diagrams/notifications/register-token.mmd b/protocol/diagrams/notifications/register-token.mmd
new file mode 100644
index 000000000..bceef296f
--- /dev/null
+++ b/protocol/diagrams/notifications/register-token.mmd
@@ -0,0 +1,30 @@
+sequenceDiagram
+  participant M as mobile app
+  participant C as chat core
+  participant A as agent
+  participant P as push server
+  participant APN as APN
+
+  note over M, APN: get device token
+  M ->> APN: registerForRemoteNotifications()
+  APN ->> M: device token
+
+  note over M, P: register device token with push server
+  M ->> C: /_ntf register <token>
+  C ->> A: registerNtfToken(<token>)
+  A ->> P: TNEW
+  P ->> A: ID (tokenId)
+  A ->> C: registered
+  C ->> M: registered
+
+  note over M, APN: verify device token
+  P ->> APN: E2E encrypted code<br>in background<br>notification
+  APN ->> M: deliver background notification with e2ee verification token
+  M ->> C: /_ntf verify <e2ee code>
+  C ->> A: verifyNtfToken(<e2ee code>)
+  A ->> P: TVFY code
+  P ->> A: OK / ERR
+  A ->> C: verified
+  C ->> M: verified
+
+  note over M, APN: now token ID can be used
diff --git a/simplexmq.cabal b/simplexmq.cabal
index c5687addf..3b9e8eb7e 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -43,10 +43,12 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
       Simplex.Messaging.Client
+      Simplex.Messaging.Client.Agent
       Simplex.Messaging.Crypto
       Simplex.Messaging.Crypto.Ratchet
       Simplex.Messaging.Encoding
       Simplex.Messaging.Encoding.String
+      Simplex.Messaging.Notifications.Client
       Simplex.Messaging.Notifications.Protocol
       Simplex.Messaging.Notifications.Server
       Simplex.Messaging.Notifications.Server.Env
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index f1ecad909..821f5fe5a 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -76,12 +76,13 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
-import Simplex.Messaging.Client (SMPServerTransmission)
+import Simplex.Messaging.Client (ServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Notifications.Protocol (DeviceToken)
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (MsgBody)
+import Simplex.Messaging.Protocol (BrokerMsg, MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (bshow, liftError, tryError, unlessM)
@@ -149,6 +150,10 @@ deleteConnection c = withAgentEnv c . deleteConnection' c
 setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServer -> m ()
 setSMPServers c = withAgentEnv c . setSMPServers' c
 
+-- | Register device notifications token
+registerNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> m ()
+registerNtfToken c = withAgentEnv c . registerNtfToken' c
+
 withAgentEnv :: AgentClient -> ReaderT Env m a -> m a
 withAgentEnv c = (`runReaderT` agentEnv c)
 
@@ -490,10 +495,13 @@ deleteConnection' c connId =
       withStore (`deleteConn` connId)
 
 -- | Change servers to be used for creating new queues, in Reader monad
-setSMPServers' :: forall m. AgentMonad m => AgentClient -> NonEmpty SMPServer -> m ()
+setSMPServers' :: AgentMonad m => AgentClient -> NonEmpty SMPServer -> m ()
 setSMPServers' c servers = do
   atomically $ writeTVar (smpServers c) servers
 
+registerNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> m ()
+registerNtfToken' c token = pure ()
+
 getSMPServer :: AgentMonad m => AgentClient -> m SMPServer
 getSMPServer c = do
   smpServers <- readTVarIO $ smpServers c
@@ -511,7 +519,7 @@ subscriber c@AgentClient {msgQ} = forever $ do
     Left e -> liftIO $ print e
     Right _ -> return ()
 
-processSMPTransmission :: forall m. AgentMonad m => AgentClient -> SMPServerTransmission -> m ()
+processSMPTransmission :: forall m. AgentMonad m => AgentClient -> ServerTransmission BrokerMsg -> m ()
 processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
   withStore (\st -> getRcvConn st srv rId) >>= \case
     SomeConn SCDuplex (DuplexConnection cData rq _) -> processSMP SCDuplex cData rq
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 96bcd4529..321fc82ab 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -2,14 +2,13 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module Simplex.Messaging.Agent.Client
   ( AgentClient (..),
@@ -57,9 +56,12 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client
+import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Protocol (QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
+import Simplex.Messaging.Notifications.Client (NtfClient)
+import Simplex.Messaging.Notifications.Protocol (NtfResponse)
+import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -67,18 +69,22 @@ import Simplex.Messaging.Util (bshow, liftEitherError, liftError, tryError, when
 import Simplex.Messaging.Version
 import System.Timeout (timeout)
 import UnliftIO (async, forConcurrently_)
-import UnliftIO.Exception (Exception, IOException)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
+type ClientVar msg = TMVar (Either AgentErrorType (ProtocolClient msg))
+
 type SMPClientVar = TMVar (Either AgentErrorType SMPClient)
 
+type NtfClientVar = TMVar (Either AgentErrorType NtfClient)
+
 data AgentClient = AgentClient
   { rcvQ :: TBQueue (ATransmission 'Client),
     subQ :: TBQueue (ATransmission 'Agent),
-    msgQ :: TBQueue SMPServerTransmission,
+    msgQ :: TBQueue (ServerTransmission BrokerMsg),
     smpServers :: TVar (NonEmpty SMPServer),
     smpClients :: TMap SMPServer SMPClientVar,
+    ntfClients :: TMap ProtocolServer NtfClientVar,
     subscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue),
     pendingSubscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue),
     subscrConns :: TMap ConnId SMPServer,
@@ -101,6 +107,7 @@ newAgentClient agentEnv = do
   msgQ <- newTBQueue qSize
   smpServers <- newTVar $ initialSMPServers (config agentEnv)
   smpClients <- TM.empty
+  ntfClients <- TM.empty
   subscrSrvrs <- TM.empty
   pendingSubscrSrvrs <- TM.empty
   subscrConns <- TM.empty
@@ -111,80 +118,30 @@ newAgentClient agentEnv = do
   asyncClients <- newTVar []
   clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
   lock <- newTMVar ()
-  return AgentClient {rcvQ, subQ, msgQ, smpServers, smpClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, asyncClients, clientId, agentEnv, smpSubscriber = undefined, lock}
+  return AgentClient {rcvQ, subQ, msgQ, smpServers, smpClients, ntfClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, asyncClients, clientId, agentEnv, smpSubscriber = undefined, lock}
 
 -- | Agent monad with MonadReader Env and MonadError AgentErrorType
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)
 
-newtype InternalException e = InternalException {unInternalException :: e}
-  deriving (Eq, Show)
+class ProtocolServerClient msg where
+  getProtocolServerClient :: AgentMonad m => AgentClient -> ProtocolServer -> m (ProtocolClient msg)
 
-instance Exception e => Exception (InternalException e)
+instance ProtocolServerClient BrokerMsg where getProtocolServerClient = getSMPServerClient
 
-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)
+instance ProtocolServerClient NtfResponse where getProtocolServerClient = getNtfServerClient
 
 getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPServer -> m SMPClient
 getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
-  atomically getClientVar >>= either newSMPClient waitForSMPClient
+  atomically (getClientVar srv smpClients)
+    >>= either
+      (newProtocolClient c srv smpClients connectClient reconnectClient)
+      (waitForProtocolClient smpCfg)
   where
-    getClientVar :: STM (Either SMPClientVar SMPClientVar)
-    getClientVar = maybe (Left <$> newClientVar) (pure . Right) =<< TM.lookup srv smpClients
-
-    newClientVar :: STM SMPClientVar
-    newClientVar = do
-      smpVar <- newEmptyTMVar
-      TM.insert srv smpVar smpClients
-      pure smpVar
-
-    waitForSMPClient :: TMVar (Either AgentErrorType SMPClient) -> m SMPClient
-    waitForSMPClient smpVar = do
-      SMPClientConfig {tcpTimeout} <- asks $ smpCfg . config
-      smpClient_ <- liftIO $ tcpTimeout `timeout` atomically (readTMVar smpVar)
-      liftEither $ case smpClient_ of
-        Just (Right smpClient) -> Right smpClient
-        Just (Left e) -> Left e
-        Nothing -> Left $ BROKER TIMEOUT
-
-    newSMPClient :: TMVar (Either AgentErrorType SMPClient) -> m SMPClient
-    newSMPClient smpVar = tryConnectClient pure tryConnectAsync
-      where
-        tryConnectClient :: (SMPClient -> m a) -> m () -> m a
-        tryConnectClient successAction retryAction =
-          tryError connectClient >>= \r -> case r of
-            Right smp -> do
-              logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
-              atomically $ putTMVar smpVar r
-              successAction smp
-            Left e -> do
-              if e == BROKER NETWORK || e == BROKER TIMEOUT
-                then retryAction
-                else atomically $ do
-                  putTMVar smpVar (Left e)
-                  TM.delete srv smpClients
-              throwError e
-        tryConnectAsync :: m ()
-        tryConnectAsync = do
-          a <- async connectAsync
-          atomically $ modifyTVar' (asyncClients c) (a :)
-        connectAsync :: m ()
-        connectAsync = do
-          ri <- asks $ reconnectInterval . config
-          withRetryInterval ri $ \loop -> void $ tryConnectClient (const reconnectClient) loop
-
     connectClient :: m SMPClient
     connectClient = do
       cfg <- asks $ smpCfg . config
       u <- askUnliftIO
-      liftEitherError smpClientError (getSMPClient srv cfg msgQ $ clientDisconnected u)
-        `E.catch` internalError
-      where
-        internalError :: IOException -> m SMPClient
-        internalError = throwError . INTERNAL . show
+      liftEitherError protocolClientError (getProtocolClient srv cfg (Just msgQ) $ clientDisconnected u)
 
     clientDisconnected :: UnliftIO m -> IO ()
     clientDisconnected u = do
@@ -194,13 +151,14 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
     removeClientAndSubs :: IO (Maybe (Map ConnId RcvQueue))
     removeClientAndSubs = atomically $ do
       TM.delete srv smpClients
-      cVar_ <- TM.lookupDelete srv $ subscrSrvrs c
-      forM cVar_ $ \cVar -> do
-        cs <- readTVar cVar
-        modifyTVar' (subscrConns c) (`M.withoutKeys` M.keysSet cs)
-        addPendingSubs cVar cs
-        pure cs
+      TM.lookupDelete srv (subscrSrvrs c) >>= mapM updateSubs
       where
+        updateSubs cVar = do
+          cs <- readTVar cVar
+          modifyTVar' (subscrConns c) (`M.withoutKeys` M.keysSet cs)
+          addPendingSubs cVar cs
+          pure cs
+
         addPendingSubs cVar cs = do
           let ps = pendingSubscrSrvrs c
           TM.lookup srv ps >>= \case
@@ -225,30 +183,100 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
 
     reconnectClient :: m ()
     reconnectClient =
-      withAgentLock c . withSMP c srv $ \smp -> do
+      withAgentLock c . withClient c srv $ \smp -> do
         cs <- atomically $ mapM readTVar =<< TM.lookup srv (pendingSubscrSrvrs c)
         forConcurrently_ (maybe [] M.toList cs) $ \sub@(connId, _) ->
           whenM (atomically $ isNothing <$> TM.lookup connId (subscrConns c)) $
             subscribe_ smp sub `catchError` handleError connId
       where
-        subscribe_ :: SMPClient -> (ConnId, RcvQueue) -> ExceptT SMPClientError IO ()
+        subscribe_ :: SMPClient -> (ConnId, RcvQueue) -> ExceptT ProtocolClientError IO ()
         subscribe_ smp (connId, rq@RcvQueue {rcvPrivateKey, rcvId}) = do
           subscribeSMPQueue smp rcvPrivateKey rcvId
           addSubscription c rq connId
           liftIO $ notifySub UP connId
 
-        handleError :: ConnId -> SMPClientError -> ExceptT SMPClientError IO ()
+        handleError :: ConnId -> ProtocolClientError -> ExceptT ProtocolClientError IO ()
         handleError connId = \case
-          e@SMPResponseTimeout -> throwError e
-          e@SMPNetworkError -> throwError e
+          e@PCEResponseTimeout -> throwError e
+          e@PCENetworkError -> throwError e
           e -> do
-            liftIO $ notifySub (ERR $ smpClientError e) connId
+            liftIO $ notifySub (ERR $ protocolClientError e) connId
             atomically $ removePendingSubscription c srv connId
 
     notifySub :: ACommand 'Agent -> ConnId -> IO ()
     notifySub cmd connId = atomically $ writeTBQueue (subQ c) ("", connId, cmd)
 
-closeAgentClient :: MonadUnliftIO m => AgentClient -> m ()
+getNtfServerClient :: forall m. AgentMonad m => AgentClient -> ProtocolServer -> m NtfClient
+getNtfServerClient c@AgentClient {ntfClients} srv =
+  atomically (getClientVar srv ntfClients)
+    >>= either
+      (newProtocolClient c srv ntfClients connectClient $ pure ())
+      (waitForProtocolClient ntfCfg)
+  where
+    connectClient :: m NtfClient
+    connectClient = do
+      cfg <- asks $ ntfCfg . config
+      liftEitherError protocolClientError (getProtocolClient srv cfg Nothing clientDisconnected)
+
+    clientDisconnected :: IO ()
+    clientDisconnected = do
+      atomically $ TM.delete srv ntfClients
+      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
+
+getClientVar :: forall a. ProtocolServer -> TMap ProtocolServer (TMVar a) -> STM (Either (TMVar a) (TMVar a))
+getClientVar srv clients = maybe (Left <$> newClientVar) (pure . Right) =<< TM.lookup srv clients
+  where
+    newClientVar :: STM (TMVar a)
+    newClientVar = do
+      var <- newEmptyTMVar
+      TM.insert srv var clients
+      pure var
+
+waitForProtocolClient :: AgentMonad m => (AgentConfig -> ProtocolClientConfig) -> ClientVar msg -> m (ProtocolClient msg)
+waitForProtocolClient clientConfig clientVar = do
+  ProtocolClientConfig {tcpTimeout} <- asks $ clientConfig . config
+  client_ <- liftIO $ tcpTimeout `timeout` atomically (readTMVar clientVar)
+  liftEither $ case client_ of
+    Just (Right smpClient) -> Right smpClient
+    Just (Left e) -> Left e
+    Nothing -> Left $ BROKER TIMEOUT
+
+newProtocolClient ::
+  forall msg m.
+  AgentMonad m =>
+  AgentClient ->
+  ProtocolServer ->
+  TMap ProtocolServer (ClientVar msg) ->
+  m (ProtocolClient msg) ->
+  m () ->
+  ClientVar msg ->
+  m (ProtocolClient msg)
+newProtocolClient c srv clients connectClient reconnectClient clientVar = tryConnectClient pure tryConnectAsync
+  where
+    tryConnectClient :: (ProtocolClient msg -> m a) -> m () -> m a
+    tryConnectClient successAction retryAction =
+      tryError connectClient >>= \r -> case r of
+        Right smp -> do
+          logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
+          atomically $ putTMVar clientVar r
+          successAction smp
+        Left e -> do
+          if e == BROKER NETWORK || e == BROKER TIMEOUT
+            then retryAction
+            else atomically $ do
+              putTMVar clientVar (Left e)
+              TM.delete srv clients
+          throwError e
+    tryConnectAsync :: m ()
+    tryConnectAsync = do
+      a <- async connectAsync
+      atomically $ modifyTVar' (asyncClients c) (a :)
+    connectAsync :: m ()
+    connectAsync = do
+      ri <- asks $ reconnectInterval . config
+      withRetryInterval ri $ \loop -> void $ tryConnectClient (const reconnectClient) loop
+
+closeAgentClient :: MonadIO m => AgentClient -> m ()
 closeAgentClient c = liftIO $ do
   closeSMPServerClients c
   cancelActions $ reconnections c
@@ -260,7 +288,7 @@ closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ (forkIO . closeCli
   where
     closeClient smpVar =
       atomically (readTMVar smpVar) >>= \case
-        Right smp -> closeSMPClient smp `E.catch` \(_ :: E.SomeException) -> pure ()
+        Right smp -> closeProtocolClient smp `E.catch` \(_ :: E.SomeException) -> pure ()
         _ -> pure ()
 
 cancelActions :: Foldable f => TVar (f (Async ())) -> IO ()
@@ -272,40 +300,40 @@ withAgentLock AgentClient {lock} =
     (void . atomically $ takeTMVar lock)
     (atomically $ putTMVar lock ())
 
-withSMP_ :: forall a m. AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> m a) -> m a
-withSMP_ c srv action =
-  (getSMPServerClient c srv >>= action) `catchError` logServerError
+withClient_ :: forall a m msg. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> (ProtocolClient msg -> m a) -> m a
+withClient_ c srv action = (getProtocolServerClient c srv >>= action) `catchError` logServerError
   where
     logServerError :: AgentErrorType -> m a
     logServerError e = do
       logServer "<--" c srv "" $ bshow e
       throwError e
 
-withLogSMP_ :: AgentMonad m => AgentClient -> SMPServer -> QueueId -> ByteString -> (SMPClient -> m a) -> m a
-withLogSMP_ c srv qId cmdStr action = do
+withLogClient_ :: (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> QueueId -> ByteString -> (ProtocolClient msg -> m a) -> m a
+withLogClient_ c srv qId cmdStr action = do
   logServer "-->" c srv qId cmdStr
-  res <- withSMP_ c srv action
+  res <- withClient_ c srv action
   logServer "<--" c srv qId "OK"
   return res
 
-withSMP :: AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> ExceptT SMPClientError IO a) -> m a
-withSMP c srv action = withSMP_ c srv $ liftSMP . action
+withClient :: (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
+withClient c srv action = withClient_ c srv $ liftClient . action
 
-withLogSMP :: AgentMonad m => AgentClient -> SMPServer -> QueueId -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> m a
-withLogSMP c srv qId cmdStr action = withLogSMP_ c srv qId cmdStr $ liftSMP . action
+withLogClient :: (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> QueueId -> ByteString -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
+withLogClient c srv qId cmdStr action = withLogClient_ c srv qId cmdStr $ liftClient . action
 
-liftSMP :: AgentMonad m => ExceptT SMPClientError IO a -> m a
-liftSMP = liftError smpClientError
+liftClient :: AgentMonad m => ExceptT ProtocolClientError IO a -> m a
+liftClient = liftError protocolClientError
 
-smpClientError :: SMPClientError -> AgentErrorType
-smpClientError = \case
-  SMPServerError e -> SMP e
-  SMPResponseError e -> BROKER $ RESPONSE e
-  SMPUnexpectedResponse -> BROKER UNEXPECTED
-  SMPResponseTimeout -> BROKER TIMEOUT
-  SMPNetworkError -> BROKER NETWORK
-  SMPTransportError e -> BROKER $ TRANSPORT e
-  e -> INTERNAL $ show e
+protocolClientError :: ProtocolClientError -> AgentErrorType
+protocolClientError = \case
+  PCEProtocolError e -> SMP e
+  PCEResponseError e -> BROKER $ RESPONSE e
+  PCEUnexpectedResponse -> BROKER UNEXPECTED
+  PCEResponseTimeout -> BROKER TIMEOUT
+  PCENetworkError -> BROKER NETWORK
+  PCETransportError e -> BROKER $ TRANSPORT e
+  e@PCESignatureError {} -> INTERNAL $ show e
+  e@PCEIOError {} -> INTERNAL $ show e
 
 newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri)
 newRcvQueue c srv =
@@ -324,7 +352,7 @@ newRcvQueue_ a c srv = do
   (e2eDhKey, e2ePrivKey) <- liftIO C.generateKeyPair'
   logServer "-->" c srv "" "NEW"
   QIK {rcvId, sndId, rcvPublicDhKey} <-
-    withSMP c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey
+    withClient c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey dhKey
   logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
   let rq =
         RcvQueue
@@ -342,15 +370,15 @@ newRcvQueue_ a c srv = do
 subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
 subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
   atomically $ addPendingSubscription c rq connId
-  withLogSMP c server rcvId "SUB" $ \smp -> do
+  withLogClient c server rcvId "SUB" $ \smp -> do
     liftIO (runExceptT $ subscribeSMPQueue smp rcvPrivateKey rcvId) >>= \case
       Left e -> do
-        atomically . when (e /= SMPNetworkError && e /= SMPResponseTimeout) $
+        atomically . when (e /= PCENetworkError && e /= PCEResponseTimeout) $
           removePendingSubscription c server connId
         throwError e
       Right _ -> addSubscription c rq connId
 
-addSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnId -> m ()
+addSubscription :: MonadIO m => AgentClient -> RcvQueue -> ConnId -> m ()
 addSubscription c rq@RcvQueue {server} connId = atomically $ do
   TM.insert connId server $ subscrConns c
   addSubs_ (subscrSrvrs c) rq connId
@@ -365,7 +393,7 @@ addSubs_ ss rq@RcvQueue {server} connId =
     Just m -> TM.insert connId rq m
     _ -> TM.singleton connId rq >>= \m -> TM.insert server m ss
 
-removeSubscription :: MonadUnliftIO m => AgentClient -> ConnId -> m ()
+removeSubscription :: MonadIO m => AgentClient -> ConnId -> m ()
 removeSubscription c@AgentClient {subscrConns} connId = atomically $ do
   server_ <- TM.lookupDelete connId subscrConns
   mapM_ (\server -> removeSubs_ (subscrSrvrs c) server connId) server_
@@ -377,12 +405,12 @@ removeSubs_ :: TMap SMPServer (TMap ConnId RcvQueue) -> SMPServer -> ConnId -> S
 removeSubs_ ss server connId =
   TM.lookup server ss >>= mapM_ (TM.delete connId)
 
-logServer :: AgentMonad m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
+logServer :: MonadIO m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
 logServer dir AgentClient {clientId} srv qId cmdStr =
   logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
 
 showServer :: SMPServer -> ByteString
-showServer SMPServer {host, port} =
+showServer ProtocolServer {host, port} =
   B.pack $ host <> if null port then "" else ':' : port
 
 logSecret :: ByteString -> ByteString
@@ -390,17 +418,17 @@ logSecret bs = encode $ B.take 3 bs
 
 sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
 sendConfirmation c sq@SndQueue {server, sndId, sndPublicKey = Just sndPublicKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation =
-  withLogSMP_ c server sndId "SEND <CONF>" $ \smp -> do
+  withLogClient_ c server sndId "SEND <CONF>" $ \smp -> do
     let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
     msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
-    liftSMP $ sendSMPMessage smp Nothing sndId msg
+    liftClient $ sendSMPMessage smp Nothing sndId msg
 sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
 
 sendInvitation :: forall m. AgentMonad m => AgentClient -> Compatible SMPQueueInfo -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> m ()
 sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) connReq connInfo =
-  withLogSMP_ c smpServer senderId "SEND <INV>" $ \smp -> do
+  withLogClient_ c smpServer senderId "SEND <INV>" $ \smp -> do
     msg <- mkInvitation
-    liftSMP $ sendSMPMessage smp Nothing senderId msg
+    liftClient $ sendSMPMessage smp Nothing senderId msg
   where
     mkInvitation :: m ByteString
     -- this is only encrypted with per-queue E2E, not with double ratchet
@@ -411,30 +439,30 @@ sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) co
 
 secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SndPublicVerifyKey -> m ()
 secureQueue c RcvQueue {server, rcvId, rcvPrivateKey} senderKey =
-  withLogSMP c server rcvId "KEY <key>" $ \smp ->
+  withLogClient c server rcvId "KEY <key>" $ \smp ->
     secureSMPQueue smp rcvPrivateKey rcvId senderKey
 
 sendAck :: AgentMonad m => AgentClient -> RcvQueue -> m ()
 sendAck c RcvQueue {server, rcvId, rcvPrivateKey} =
-  withLogSMP c server rcvId "ACK" $ \smp ->
+  withLogClient c server rcvId "ACK" $ \smp ->
     ackSMPMessage smp rcvPrivateKey rcvId
 
 suspendQueue :: AgentMonad m => AgentClient -> RcvQueue -> m ()
 suspendQueue c RcvQueue {server, rcvId, rcvPrivateKey} =
-  withLogSMP c server rcvId "OFF" $ \smp ->
+  withLogClient c server rcvId "OFF" $ \smp ->
     suspendSMPQueue smp rcvPrivateKey rcvId
 
 deleteQueue :: AgentMonad m => AgentClient -> RcvQueue -> m ()
 deleteQueue c RcvQueue {server, rcvId, rcvPrivateKey} =
-  withLogSMP c server rcvId "DEL" $ \smp ->
+  withLogClient c server rcvId "DEL" $ \smp ->
     deleteSMPQueue smp rcvPrivateKey rcvId
 
 sendAgentMessage :: forall m. AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
 sendAgentMessage c sq@SndQueue {server, sndId, sndPrivateKey} agentMsg =
-  withLogSMP_ c server sndId "SEND <MSG>" $ \smp -> do
+  withLogClient_ c server sndId "SEND <MSG>" $ \smp -> do
     let clientMsg = SMP.ClientMessage SMP.PHEmpty agentMsg
     msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
-    liftSMP $ sendSMPMessage smp (Just sndPrivateKey) sndId msg
+    liftClient $ sendSMPMessage smp (Just sndPrivateKey) sndId msg
 
 agentCbEncrypt :: AgentMonad m => SndQueue -> Maybe C.PublicKeyX25519 -> ByteString -> m ByteString
 agentCbEncrypt SndQueue {e2eDhSecret} e2ePubKey msg = do
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index a1f03cf6f..66f510ff6 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -23,6 +23,7 @@ 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 Simplex.Messaging.Client.Agent (SMPClientAgentConfig, defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import System.Random (StdGen, newStdGen)
 import UnliftIO.STM
@@ -36,7 +37,8 @@ data AgentConfig = AgentConfig
     dbFile :: FilePath,
     dbPoolSize :: Int,
     yesToMigrations :: Bool,
-    smpCfg :: SMPClientConfig,
+    smpCfg :: ProtocolClientConfig,
+    ntfCfg :: ProtocolClientConfig,
     reconnectInterval :: RetryInterval,
     helloTimeout :: NominalDiffTime,
     caCertificateFile :: FilePath,
@@ -55,7 +57,8 @@ defaultAgentConfig =
       dbFile = "smp-agent.db",
       dbPoolSize = 4,
       yesToMigrations = False,
-      smpCfg = smpDefaultConfig,
+      smpCfg = defaultClientConfig,
+      ntfCfg = defaultClientConfig,
       reconnectInterval =
         RetryInterval
           { initialInterval = second,
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index fa1d46a8a..dbe47d908 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -49,7 +50,8 @@ module Simplex.Messaging.Agent.Protocol
     AgentMessageType (..),
     APrivHeader (..),
     AMessage (..),
-    SMPServer (..),
+    SMPServer,
+    pattern SMPServer,
     SrvLoc (..),
     SMPQueueUri (..),
     SMPQueueInfo (..),
@@ -131,9 +133,10 @@ import Simplex.Messaging.Protocol
   ( ErrorType,
     MsgBody,
     MsgId,
-    SMPServer (..),
+    SMPServer,
     SndPublicVerifyKey,
     SrvLoc (..),
+    pattern SMPServer,
   )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTransportError, transportErrorP)
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 295e28620..89a3c0e69 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -59,7 +60,7 @@ import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), Skipp
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldParser)
-import Simplex.Messaging.Protocol (MsgBody)
+import Simplex.Messaging.Protocol (MsgBody, ProtocolServer (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (bshow, liftIOEither)
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
@@ -127,9 +128,26 @@ connectSQLiteStore dbFilePath poolSize = do
 connectDB :: FilePath -> IO DB.Connection
 connectDB path = do
   dbConn <- DB.open path
-  DB.execute_ dbConn "PRAGMA foreign_keys = ON; PRAGMA journal_mode = WAL;"
+  DB.execute_ dbConn "PRAGMA foreign_keys = ON;"
+  -- DB.execute_ dbConn "PRAGMA trusted_schema = OFF;"
+  DB.execute_ dbConn "PRAGMA secure_delete = ON;"
+  DB.execute_ dbConn "PRAGMA auto_vacuum = FULL;"
+  DB.execute_ dbConn "VACUUM;"
+  -- _printPragmas dbConn path
   pure dbConn
 
+_printPragmas :: DB.Connection -> FilePath -> IO ()
+_printPragmas db path = do
+  foreign_keys <- DB.query_ db "PRAGMA foreign_keys;" :: IO [[Int]]
+  print $ path <> " foreign_keys: " <> show foreign_keys
+  -- when run via sqlite-simple query for trusted_schema seems to return empty list
+  trusted_schema <- DB.query_ db "PRAGMA trusted_schema;" :: IO [[Int]]
+  print $ path <> " trusted_schema: " <> show trusted_schema
+  secure_delete <- DB.query_ db "PRAGMA secure_delete;" :: IO [[Int]]
+  print $ path <> " secure_delete: " <> show secure_delete
+  auto_vacuum <- DB.query_ db "PRAGMA auto_vacuum;" :: IO [[Int]]
+  print $ path <> " auto_vacuum: " <> show auto_vacuum
+
 checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
 checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)
 
@@ -190,7 +208,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
       getConn_ db connId
 
   getRcvConn :: SQLiteStore -> SMPServer -> SMP.RecipientId -> m SomeConn
-  getRcvConn st SMPServer {host, port} rcvId =
+  getRcvConn st ProtocolServer {host, port} rcvId =
     liftIOEither . withTransaction st $ \db ->
       DB.queryNamed
         db
@@ -235,7 +253,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         _ -> pure $ Left SEConnNotFound
 
   setRcvQueueStatus :: SQLiteStore -> RcvQueue -> QueueStatus -> m ()
-  setRcvQueueStatus st RcvQueue {rcvId, server = SMPServer {host, port}} status =
+  setRcvQueueStatus st RcvQueue {rcvId, server = ProtocolServer {host, port}} status =
     -- ? throw error if queue does not exist?
     liftIO . withTransaction st $ \db ->
       DB.executeNamed
@@ -248,7 +266,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         [":status" := status, ":host" := host, ":port" := port, ":rcv_id" := rcvId]
 
   setRcvQueueConfirmedE2E :: SQLiteStore -> RcvQueue -> C.DhSecretX25519 -> m ()
-  setRcvQueueConfirmedE2E st RcvQueue {rcvId, server = SMPServer {host, port}} e2eDhSecret =
+  setRcvQueueConfirmedE2E st RcvQueue {rcvId, server = ProtocolServer {host, port}} e2eDhSecret =
     liftIO . withTransaction st $ \db ->
       DB.executeNamed
         db
@@ -266,7 +284,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         ]
 
   setSndQueueStatus :: SQLiteStore -> SndQueue -> QueueStatus -> m ()
-  setSndQueueStatus st SndQueue {sndId, server = SMPServer {host, port}} status =
+  setSndQueueStatus st SndQueue {sndId, server = ProtocolServer {host, port}} status =
     -- ? throw error if queue does not exist?
     liftIO . withTransaction st $ \db ->
       DB.executeNamed
@@ -640,7 +658,7 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
 -- * Server upsert helper
 
 upsertServer_ :: DB.Connection -> SMPServer -> IO ()
-upsertServer_ dbConn SMPServer {host, port, keyHash} = do
+upsertServer_ dbConn ProtocolServer {host, port, keyHash} = do
   DB.executeNamed
     dbConn
     [sql|
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index df28de2c2..db30d3085 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -23,9 +24,10 @@
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
 module Simplex.Messaging.Client
   ( -- * Connect (disconnect) client to (from) SMP server
+    ProtocolClient,
     SMPClient,
-    getSMPClient,
-    closeSMPClient,
+    getProtocolClient,
+    closeProtocolClient,
 
     -- * SMP protocol command functions
     createSMPQueue,
@@ -37,13 +39,13 @@ module Simplex.Messaging.Client
     ackSMPMessage,
     suspendSMPQueue,
     deleteSMPQueue,
-    sendSMPCommand,
+    sendProtocolCommand,
 
     -- * Supporting types and client configuration
-    SMPClientError (..),
-    SMPClientConfig (..),
-    smpDefaultConfig,
-    SMPServerTransmission,
+    ProtocolClientError (..),
+    ProtocolClientConfig (..),
+    defaultClientConfig,
+    ServerTransmission,
   )
 where
 
@@ -60,7 +62,7 @@ import Data.Maybe (fromMaybe)
 import Network.Socket (ServiceName)
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol
+import Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError)
@@ -72,31 +74,30 @@ import System.Timeout (timeout)
 
 -- | 'SMPClient' is a handle used to send commands to a specific SMP server.
 --
--- The only exported selector is blockSize that is negotiated
--- with the server during the TCP transport handshake.
---
 -- Use 'getSMPClient' to connect to an SMP server and create a client handle.
-data SMPClient = SMPClient
+data ProtocolClient msg = ProtocolClient
   { action :: Async (),
     connected :: TVar Bool,
     sessionId :: ByteString,
-    smpServer :: SMPServer,
+    protocolServer :: ProtocolServer,
     tcpTimeout :: Int,
     clientCorrId :: TVar Natural,
-    sentCommands :: TMap CorrId Request,
+    sentCommands :: TMap CorrId (Request msg),
     sndQ :: TBQueue SentRawTransmission,
-    rcvQ :: TBQueue (SignedTransmission BrokerMsg),
-    msgQ :: TBQueue SMPServerTransmission
+    rcvQ :: TBQueue (SignedTransmission msg),
+    msgQ :: Maybe (TBQueue (ServerTransmission msg))
   }
 
--- | Type synonym for transmission from some SPM server queue.
-type SMPServerTransmission = (SMPServer, RecipientId, BrokerMsg)
+type SMPClient = ProtocolClient SMP.BrokerMsg
 
--- | SMP client configuration.
-data SMPClientConfig = SMPClientConfig
+-- | Type synonym for transmission from some SPM server queue.
+type ServerTransmission msg = (ProtocolServer, QueueId, msg)
+
+-- | protocol client configuration.
+data ProtocolClientConfig = ProtocolClientConfig
   { -- | size of TBQueue to use for server commands and responses
     qSize :: Natural,
-    -- | default SMP server port if port is not specified in SMPServer
+    -- | default server port if port is not specified in ProtocolServer
     defaultTransport :: (ServiceName, ATransport),
     -- | timeout of TCP commands (microseconds)
     tcpTimeout :: Int,
@@ -106,34 +107,35 @@ data SMPClientConfig = SMPClientConfig
     smpPing :: Int
   }
 
--- | Default SMP client configuration.
-smpDefaultConfig :: SMPClientConfig
-smpDefaultConfig =
-  SMPClientConfig
+-- | Default protocol client configuration.
+defaultClientConfig :: ProtocolClientConfig
+defaultClientConfig =
+  ProtocolClientConfig
     { qSize = 64,
       defaultTransport = ("5223", transport @TLS),
-      tcpTimeout = 4_000_000,
+      tcpTimeout = 5_000_000,
       tcpKeepAlive = Just defaultKeepAliveOpts,
-      smpPing = 600_000_000 -- 10min
+      smpPing = 300_000_000 -- 5 min
     }
 
-data Request = Request
+data Request msg = Request
   { queueId :: QueueId,
-    responseVar :: TMVar Response
+    responseVar :: TMVar (Response msg)
   }
 
-type Response = Either SMPClientError BrokerMsg
+type Response msg = Either ProtocolClientError msg
 
--- | Connects to 'SMPServer' using passed client configuration
+-- | Connects to 'ProtocolServer' using passed client configuration
 -- and queue for messages and notifications.
 --
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
-getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO (Either SMPClientError SMPClient)
-getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing} msgQ disconnected =
-  atomically mkSMPClient >>= runClient useTransport
+getProtocolClient :: forall msg. Protocol msg => ProtocolServer -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> IO () -> IO (Either ProtocolClientError (ProtocolClient msg))
+getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing} msgQ disconnected =
+  (atomically mkSMPClient >>= runClient useTransport)
+    `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
   where
-    mkSMPClient :: STM SMPClient
+    mkSMPClient :: STM (ProtocolClient msg)
     mkSMPClient = do
       connected <- newTVar False
       clientCorrId <- newTVar 0
@@ -141,11 +143,11 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smp
       sndQ <- newTBQueue qSize
       rcvQ <- newTBQueue qSize
       return
-        SMPClient
+        ProtocolClient
           { action = undefined,
             sessionId = undefined,
             connected,
-            smpServer,
+            protocolServer,
             tcpTimeout,
             clientCorrId,
             sentCommands,
@@ -154,50 +156,51 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smp
             msgQ
           }
 
-    runClient :: (ServiceName, ATransport) -> SMPClient -> IO (Either SMPClientError SMPClient)
+    runClient :: (ServiceName, ATransport) -> ProtocolClient msg -> IO (Either ProtocolClientError (ProtocolClient msg))
     runClient (port', ATransport t) c = do
       thVar <- newEmptyTMVarIO
       action <-
         async $
-          runTransportClient (host smpServer) port' (keyHash smpServer) tcpKeepAlive (client t c thVar)
-            `finally` atomically (putTMVar thVar $ Left SMPNetworkError)
+          runTransportClient (host protocolServer) port' (keyHash protocolServer) tcpKeepAlive (client t c thVar)
+            `finally` atomically (putTMVar thVar $ Left PCENetworkError)
       th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar)
       pure $ case th_ of
         Just (Right THandle {sessionId}) -> Right c {action, sessionId}
         Just (Left e) -> Left e
-        Nothing -> Left SMPNetworkError
+        Nothing -> Left PCENetworkError
 
     useTransport :: (ServiceName, ATransport)
-    useTransport = case port smpServer of
+    useTransport = case port protocolServer of
       "" -> defaultTransport cfg
       "80" -> ("80", transport @WS)
       p -> (p, transport @TLS)
 
-    client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError (THandle c)) -> c -> IO ()
+    client :: forall c. Transport c => TProxy c -> ProtocolClient msg -> TMVar (Either ProtocolClientError (THandle c)) -> c -> IO ()
     client _ c thVar h =
-      runExceptT (smpClientHandshake h $ keyHash smpServer) >>= \case
-        Left e -> atomically . putTMVar thVar . Left $ SMPTransportError e
+      runExceptT (smpClientHandshake h $ keyHash protocolServer) >>= \case
+        Left e -> atomically . putTMVar thVar . Left $ PCETransportError e
         Right th@THandle {sessionId} -> do
           atomically $ do
             writeTVar (connected c) True
             putTMVar thVar $ Right th
-          let c' = c {sessionId} :: SMPClient
+          let c' = c {sessionId} :: ProtocolClient msg
+          -- TODO remove ping if 0 is passed (or Nothing?)
           raceAny_ [send c' th, process c', receive c' th, ping c']
             `finally` disconnected
 
-    send :: Transport c => SMPClient -> THandle c -> IO ()
-    send SMPClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
+    send :: Transport c => ProtocolClient msg -> THandle c -> IO ()
+    send ProtocolClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
 
-    receive :: Transport c => SMPClient -> THandle c -> IO ()
-    receive SMPClient {rcvQ} h = forever $ tGet h >>= atomically . writeTBQueue rcvQ
+    receive :: Transport c => ProtocolClient msg -> THandle c -> IO ()
+    receive ProtocolClient {rcvQ} h = forever $ tGet h >>= atomically . writeTBQueue rcvQ
 
-    ping :: SMPClient -> IO ()
+    ping :: ProtocolClient msg -> IO ()
     ping c = forever $ do
       threadDelay smpPing
-      runExceptT $ sendSMPCommand c Nothing "" PING
+      void . either throwIO pure =<< runExceptT (sendProtocolCommand c Nothing "" protocolPing)
 
-    process :: SMPClient -> IO ()
-    process SMPClient {rcvQ, sentCommands} = forever $ do
+    process :: ProtocolClient msg -> IO ()
+    process ProtocolClient {rcvQ, sentCommands} = forever $ do
       (_, _, (corrId, qId, respOrErr)) <- atomically $ readTBQueue rcvQ
       if B.null $ bs corrId
         then sendMsg qId respOrErr
@@ -209,45 +212,48 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, tcpKeepAlive, smp
               putTMVar responseVar $
                 if queueId == qId
                   then case respOrErr of
-                    Left e -> Left $ SMPResponseError e
-                    Right (ERR e) -> Left $ SMPServerError e
-                    Right r -> Right r
-                  else Left SMPUnexpectedResponse
+                    Left e -> Left $ PCEResponseError e
+                    Right r -> case protocolError r of
+                      Just e -> Left $ PCEProtocolError e
+                      _ -> Right r
+                  else Left PCEUnexpectedResponse
 
-    sendMsg :: QueueId -> Either ErrorType BrokerMsg -> IO ()
+    sendMsg :: QueueId -> Either ErrorType msg -> IO ()
     sendMsg qId = \case
-      Right cmd -> atomically $ writeTBQueue msgQ (smpServer, qId, cmd)
+      Right cmd -> atomically $ mapM_ (`writeTBQueue` (protocolServer, qId, cmd)) msgQ
       -- TODO send everything else to errQ and log in agent
       _ -> return ()
 
--- | Disconnects SMP client from the server and terminates client threads.
-closeSMPClient :: SMPClient -> IO ()
-closeSMPClient = uninterruptibleCancel . action
+-- | Disconnects client from the server and terminates client threads.
+closeProtocolClient :: ProtocolClient msg -> IO ()
+closeProtocolClient = uninterruptibleCancel . action
 
 -- | SMP client error type.
-data SMPClientError
+data ProtocolClientError
   = -- | Correctly parsed SMP server ERR response.
     -- This error is forwarded to the agent client as `ERR SMP err`.
-    SMPServerError ErrorType
+    PCEProtocolError ErrorType
   | -- | Invalid server response that failed to parse.
     -- Forwarded to the agent client as `ERR BROKER RESPONSE`.
-    SMPResponseError ErrorType
+    PCEResponseError ErrorType
   | -- | Different response from what is expected to a certain SMP command,
     -- e.g. server should respond `IDS` or `ERR` to `NEW` command,
     -- other responses would result in this error.
     -- Forwarded to the agent client as `ERR BROKER UNEXPECTED`.
-    SMPUnexpectedResponse
+    PCEUnexpectedResponse
   | -- | Used for TCP connection and command response timeouts.
     -- Forwarded to the agent client as `ERR BROKER TIMEOUT`.
-    SMPResponseTimeout
+    PCEResponseTimeout
   | -- | Failure to establish TCP connection.
     -- Forwarded to the agent client as `ERR BROKER NETWORK`.
-    SMPNetworkError
+    PCENetworkError
   | -- | TCP transport handshake or some other transport error.
     -- Forwarded to the agent client as `ERR BROKER TRANSPORT e`.
-    SMPTransportError TransportError
+    PCETransportError TransportError
   | -- | Error when cryptographically "signing" the command.
-    SMPSignatureError C.CryptoError
+    PCESignatureError C.CryptoError
+  | -- | IO Error
+    PCEIOError IOException
   deriving (Eq, Show, Exception)
 
 -- | Create a new SMP queue.
@@ -258,92 +264,95 @@ createSMPQueue ::
   RcvPrivateSignKey ->
   RcvPublicVerifyKey ->
   RcvPublicDhKey ->
-  ExceptT SMPClientError IO QueueIdsKeys
+  ExceptT ProtocolClientError IO QueueIdsKeys
 createSMPQueue c rpKey rKey dhKey =
   sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey) >>= \case
     IDS qik -> pure qik
-    _ -> throwE SMPUnexpectedResponse
+    _ -> throwE PCEUnexpectedResponse
 
 -- | Subscribe to the SMP queue.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue
-subscribeSMPQueue :: SMPClient -> RcvPrivateSignKey -> RecipientId -> ExceptT SMPClientError IO ()
-subscribeSMPQueue c@SMPClient {smpServer, msgQ} rpKey rId =
+subscribeSMPQueue :: SMPClient -> RcvPrivateSignKey -> RecipientId -> ExceptT ProtocolClientError IO ()
+subscribeSMPQueue c@ProtocolClient {protocolServer, msgQ} rpKey rId =
   sendSMPCommand c (Just rpKey) rId SUB >>= \case
     OK -> return ()
     cmd@MSG {} ->
-      lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
-    _ -> throwE SMPUnexpectedResponse
+      lift . atomically $ mapM_ (`writeTBQueue` (protocolServer, rId, cmd)) msgQ
+    _ -> throwE PCEUnexpectedResponse
 
 -- | Subscribe to the SMP queue notifications.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue-notifications
-subscribeSMPQueueNotifications :: SMPClient -> NtfPrivateSignKey -> NotifierId -> ExceptT SMPClientError IO ()
+subscribeSMPQueueNotifications :: SMPClient -> NtfPrivateSignKey -> NotifierId -> ExceptT ProtocolClientError IO ()
 subscribeSMPQueueNotifications = okSMPCommand 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 -> RcvPrivateSignKey -> RecipientId -> SndPublicVerifyKey -> ExceptT SMPClientError IO ()
+secureSMPQueue :: SMPClient -> RcvPrivateSignKey -> RecipientId -> SndPublicVerifyKey -> ExceptT ProtocolClientError IO ()
 secureSMPQueue c rpKey rId senderKey = okSMPCommand (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 -> RcvPrivateSignKey -> RecipientId -> NtfPublicVerifyKey -> ExceptT SMPClientError IO NotifierId
+enableSMPQueueNotifications :: SMPClient -> RcvPrivateSignKey -> RecipientId -> NtfPublicVerifyKey -> ExceptT ProtocolClientError IO NotifierId
 enableSMPQueueNotifications c rpKey rId notifierKey =
   sendSMPCommand c (Just rpKey) rId (NKEY notifierKey) >>= \case
     NID nId -> pure nId
-    _ -> throwE SMPUnexpectedResponse
+    _ -> throwE PCEUnexpectedResponse
 
 -- | Send SMP message.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message
-sendSMPMessage :: SMPClient -> Maybe SndPrivateSignKey -> SenderId -> MsgBody -> ExceptT SMPClientError IO ()
+sendSMPMessage :: SMPClient -> Maybe SndPrivateSignKey -> SenderId -> MsgBody -> ExceptT ProtocolClientError IO ()
 sendSMPMessage c spKey sId msg =
   sendSMPCommand c spKey sId (SEND msg) >>= \case
     OK -> pure ()
-    _ -> throwE SMPUnexpectedResponse
+    _ -> throwE PCEUnexpectedResponse
 
 -- | Acknowledge message delivery (server deletes the message).
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
-ackSMPMessage :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
-ackSMPMessage c@SMPClient {smpServer, msgQ} rpKey rId =
+ackSMPMessage :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT ProtocolClientError IO ()
+ackSMPMessage c@ProtocolClient {protocolServer, msgQ} rpKey rId =
   sendSMPCommand c (Just rpKey) rId ACK >>= \case
     OK -> return ()
     cmd@MSG {} ->
-      lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd)
-    _ -> throwE SMPUnexpectedResponse
+      lift . atomically $ mapM_ (`writeTBQueue` (protocolServer, rId, cmd)) msgQ
+    _ -> throwE PCEUnexpectedResponse
 
 -- | Irreversibly suspend SMP queue.
 -- The existing messages from the queue will still be delivered.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#suspend-queue
-suspendSMPQueue :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
+suspendSMPQueue :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT ProtocolClientError IO ()
 suspendSMPQueue = okSMPCommand OFF
 
 -- | Irreversibly delete SMP queue and all messages in it.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#delete-queue
-deleteSMPQueue :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
+deleteSMPQueue :: SMPClient -> RcvPrivateSignKey -> QueueId -> ExceptT ProtocolClientError IO ()
 deleteSMPQueue = okSMPCommand DEL
 
-okSMPCommand :: PartyI p => Command p -> SMPClient -> C.APrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
+okSMPCommand :: PartyI p => Command p -> SMPClient -> C.APrivateSignKey -> QueueId -> ExceptT ProtocolClientError IO ()
 okSMPCommand cmd c pKey qId =
   sendSMPCommand c (Just pKey) qId cmd >>= \case
     OK -> return ()
-    _ -> throwE SMPUnexpectedResponse
+    _ -> throwE PCEUnexpectedResponse
 
 -- | Send SMP command
--- TODO sign all requests (SEND of SMP confirmation would be signed with the same key that is passed to the recipient)
-sendSMPCommand :: PartyI p => SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Command p -> ExceptT SMPClientError IO BrokerMsg
-sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, sessionId, tcpTimeout} pKey qId cmd = do
+sendSMPCommand :: PartyI p => SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Command p -> ExceptT ProtocolClientError IO BrokerMsg
+sendSMPCommand c pKey qId = sendProtocolCommand c pKey qId . Cmd sParty
+
+-- | Send Protocol command
+sendProtocolCommand :: forall msg. ProtocolEncoding (ProtocolCommand msg) => ProtocolClient msg -> Maybe C.APrivateSignKey -> QueueId -> ProtocolCommand msg -> ExceptT ProtocolClientError IO msg
+sendProtocolCommand ProtocolClient {sndQ, sentCommands, clientCorrId, sessionId, tcpTimeout} pKey qId cmd = do
   corrId <- lift_ getNextCorrId
   t <- signTransmission $ encodeTransmission sessionId (corrId, qId, cmd)
   ExceptT $ sendRecv corrId t
   where
-    lift_ :: STM a -> ExceptT SMPClientError IO a
+    lift_ :: STM a -> ExceptT ProtocolClientError IO a
     lift_ action = ExceptT $ Right <$> atomically action
 
     getNextCorrId :: STM CorrId
@@ -351,20 +360,20 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, sessionId, tcpTimeou
       i <- stateTVar clientCorrId $ \i -> (i, i + 1)
       pure . CorrId $ bshow i
 
-    signTransmission :: ByteString -> ExceptT SMPClientError IO SentRawTransmission
+    signTransmission :: ByteString -> ExceptT ProtocolClientError IO SentRawTransmission
     signTransmission t = case pKey of
       Nothing -> return (Nothing, t)
       Just pk -> do
-        sig <- liftError SMPSignatureError $ C.sign pk t
+        sig <- liftError PCESignatureError $ C.sign pk t
         return (Just sig, t)
 
     -- two separate "atomically" needed to avoid blocking
-    sendRecv :: CorrId -> SentRawTransmission -> IO Response
+    sendRecv :: CorrId -> SentRawTransmission -> IO (Response msg)
     sendRecv corrId t = atomically (send corrId t) >>= withTimeout . atomically . takeTMVar
       where
-        withTimeout a = fromMaybe (Left SMPResponseTimeout) <$> timeout tcpTimeout a
+        withTimeout a = fromMaybe (Left PCEResponseTimeout) <$> timeout tcpTimeout a
 
-    send :: CorrId -> SentRawTransmission -> STM (TMVar Response)
+    send :: CorrId -> SentRawTransmission -> STM (TMVar (Response msg))
     send corrId t = do
       r <- newEmptyTMVar
       TM.insert corrId (Request qId r) sentCommands
diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
new file mode 100644
index 000000000..7a62dc465
--- /dev/null
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -0,0 +1,301 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Simplex.Messaging.Client.Agent where
+
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Async (Async, uninterruptibleCancel)
+import Control.Logger.Simple
+import Control.Monad.Except
+import Control.Monad.IO.Unlift
+import Control.Monad.Trans.Except
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Set (Set)
+import Data.Text.Encoding
+import Numeric.Natural
+import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Client
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, SMPServer)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (tryE, whenM)
+import System.Timeout (timeout)
+import UnliftIO (async, forConcurrently_)
+import UnliftIO.Exception (Exception)
+import qualified UnliftIO.Exception as E
+import UnliftIO.STM
+
+type SMPClientVar = TMVar (Either ProtocolClientError SMPClient)
+
+data SMPClientAgentEvent
+  = CAConnected SMPServer
+  | CADisconnected SMPServer (Set SMPSub)
+  | CAReconnected SMPServer
+  | CAResubscribed SMPServer SMPSub
+  | CASubError SMPServer SMPSub ProtocolClientError
+
+data SMPSubParty = SPRecipient | SPNotifier
+  deriving (Eq, Ord)
+
+type SMPSub = (SMPSubParty, QueueId)
+
+-- type SMPServerSub = (SMPServer, SMPSub)
+
+data SMPClientAgentConfig = SMPClientAgentConfig
+  { smpCfg :: ProtocolClientConfig,
+    reconnectInterval :: RetryInterval,
+    msgQSize :: Natural,
+    agentQSize :: Natural
+  }
+
+defaultSMPClientAgentConfig :: SMPClientAgentConfig
+defaultSMPClientAgentConfig =
+  SMPClientAgentConfig
+    { smpCfg = defaultClientConfig,
+      reconnectInterval =
+        RetryInterval
+          { initialInterval = second,
+            increaseAfter = 10 * second,
+            maxInterval = 10 * second
+          },
+      msgQSize = 64,
+      agentQSize = 64
+    }
+  where
+    second = 1000000
+
+data SMPClientAgent = SMPClientAgent
+  { agentCfg :: SMPClientAgentConfig,
+    msgQ :: TBQueue (ServerTransmission BrokerMsg),
+    agentQ :: TBQueue SMPClientAgentEvent,
+    smpClients :: TMap SMPServer SMPClientVar,
+    srvSubs :: TMap SMPServer (TMap SMPSub C.APrivateSignKey),
+    pendingSrvSubs :: TMap SMPServer (TMap SMPSub C.APrivateSignKey),
+    reconnections :: TVar [Async ()],
+    asyncClients :: TVar [Async ()]
+  }
+
+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)
+
+newSMPClientAgent :: SMPClientAgentConfig -> STM SMPClientAgent
+newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} = do
+  msgQ <- newTBQueue msgQSize
+  agentQ <- newTBQueue agentQSize
+  smpClients <- TM.empty
+  srvSubs <- TM.empty
+  pendingSrvSubs <- TM.empty
+  reconnections <- newTVar []
+  asyncClients <- newTVar []
+  pure SMPClientAgent {agentCfg, msgQ, agentQ, smpClients, srvSubs, pendingSrvSubs, reconnections, asyncClients}
+
+getSMPServerClient' :: SMPClientAgent -> SMPServer -> ExceptT ProtocolClientError IO SMPClient
+getSMPServerClient' ca@SMPClientAgent {agentCfg, smpClients, msgQ} srv =
+  atomically getClientVar >>= either newSMPClient waitForSMPClient
+  where
+    getClientVar :: STM (Either SMPClientVar SMPClientVar)
+    getClientVar = maybe (Left <$> newClientVar) (pure . Right) =<< TM.lookup srv smpClients
+
+    newClientVar :: STM SMPClientVar
+    newClientVar = do
+      smpVar <- newEmptyTMVar
+      TM.insert srv smpVar smpClients
+      pure smpVar
+
+    waitForSMPClient :: SMPClientVar -> ExceptT ProtocolClientError IO SMPClient
+    waitForSMPClient smpVar = do
+      let ProtocolClientConfig {tcpTimeout} = smpCfg agentCfg
+      smpClient_ <- liftIO $ tcpTimeout `timeout` atomically (readTMVar smpVar)
+      liftEither $ case smpClient_ of
+        Just (Right smpClient) -> Right smpClient
+        Just (Left e) -> Left e
+        Nothing -> Left PCEResponseTimeout
+
+    newSMPClient :: SMPClientVar -> ExceptT ProtocolClientError IO SMPClient
+    newSMPClient smpVar = tryConnectClient pure tryConnectAsync
+      where
+        tryConnectClient :: (SMPClient -> ExceptT ProtocolClientError IO a) -> ExceptT ProtocolClientError IO () -> ExceptT ProtocolClientError IO a
+        tryConnectClient successAction retryAction =
+          tryE connectClient >>= \r -> case r of
+            Right smp -> do
+              logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
+              atomically $ putTMVar smpVar r
+              successAction smp
+            Left e -> do
+              if e == PCENetworkError || e == PCEResponseTimeout
+                then retryAction
+                else atomically $ do
+                  putTMVar smpVar (Left e)
+                  TM.delete srv smpClients
+              throwE e
+        tryConnectAsync :: ExceptT ProtocolClientError IO ()
+        tryConnectAsync = do
+          a <- async connectAsync
+          atomically $ modifyTVar' (asyncClients ca) (a :)
+        connectAsync :: ExceptT ProtocolClientError IO ()
+        connectAsync =
+          withRetryInterval (reconnectInterval agentCfg) $ \loop ->
+            void $ tryConnectClient (const reconnectClient) loop
+
+    connectClient :: ExceptT ProtocolClientError IO SMPClient
+    connectClient = ExceptT $ getProtocolClient srv (smpCfg agentCfg) (Just msgQ) clientDisconnected
+
+    clientDisconnected :: IO ()
+    clientDisconnected = do
+      removeClientAndSubs >>= (`forM_` serverDown)
+      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
+
+    removeClientAndSubs :: IO (Maybe (Map SMPSub C.APrivateSignKey))
+    removeClientAndSubs = atomically $ do
+      TM.delete srv smpClients
+      TM.lookupDelete srv (srvSubs ca) >>= mapM updateSubs
+      where
+        updateSubs sVar = do
+          ss <- readTVar sVar
+          addPendingSubs sVar ss
+          pure ss
+
+        addPendingSubs sVar ss = do
+          let ps = pendingSrvSubs ca
+          TM.lookup srv ps >>= \case
+            Just v -> TM.union ss v
+            _ -> TM.insert srv sVar ps
+
+    serverDown :: Map SMPSub C.APrivateSignKey -> IO ()
+    serverDown ss = unless (M.null ss) . void . runExceptT $ do
+      notify . CADisconnected srv $ M.keysSet ss
+      reconnectServer
+
+    reconnectServer :: ExceptT ProtocolClientError IO ()
+    reconnectServer = do
+      a <- async tryReconnectClient
+      atomically $ modifyTVar' (reconnections ca) (a :)
+
+    tryReconnectClient :: ExceptT ProtocolClientError IO ()
+    tryReconnectClient = do
+      withRetryInterval (reconnectInterval agentCfg) $ \loop ->
+        reconnectClient `catchE` const loop
+
+    reconnectClient :: ExceptT ProtocolClientError IO ()
+    reconnectClient = do
+      withSMP ca srv $ \smp -> do
+        notify $ CAReconnected srv
+        cs <- atomically $ mapM readTVar =<< TM.lookup srv (pendingSrvSubs ca)
+        forConcurrently_ (maybe [] M.assocs cs) $ \sub@(s, _) ->
+          whenM (atomically $ hasSub (srvSubs ca) srv s) $
+            subscribe_ smp sub `catchE` handleError s
+      where
+        subscribe_ :: SMPClient -> (SMPSub, C.APrivateSignKey) -> ExceptT ProtocolClientError IO ()
+        subscribe_ smp sub@(s, _) = do
+          smpSubscribe smp sub
+          atomically $ addSubscription ca srv sub
+          notify $ CAResubscribed srv s
+
+        handleError :: SMPSub -> ProtocolClientError -> ExceptT ProtocolClientError IO ()
+        handleError s = \case
+          e@PCEResponseTimeout -> throwE e
+          e@PCENetworkError -> throwE e
+          e -> do
+            notify $ CASubError srv s e
+            atomically $ removePendingSubscription ca srv s
+
+    notify :: SMPClientAgentEvent -> ExceptT ProtocolClientError IO ()
+    notify evt = atomically $ writeTBQueue (agentQ ca) evt
+
+closeSMPClientAgent :: MonadUnliftIO m => SMPClientAgent -> m ()
+closeSMPClientAgent c = liftIO $ do
+  closeSMPServerClients c
+  cancelActions $ reconnections c
+  cancelActions $ asyncClients c
+
+closeSMPServerClients :: SMPClientAgent -> IO ()
+closeSMPServerClients c = readTVarIO (smpClients c) >>= mapM_ (forkIO . closeClient)
+  where
+    closeClient smpVar =
+      atomically (readTMVar smpVar) >>= \case
+        Right smp -> closeProtocolClient smp `E.catch` \(_ :: E.SomeException) -> pure ()
+        _ -> pure ()
+
+cancelActions :: Foldable f => TVar (f (Async ())) -> IO ()
+cancelActions as = readTVarIO as >>= mapM_ uninterruptibleCancel
+
+withSMP :: SMPClientAgent -> SMPServer -> (SMPClient -> ExceptT ProtocolClientError IO a) -> ExceptT ProtocolClientError IO a
+withSMP ca srv action = (getSMPServerClient' ca srv >>= action) `catchE` logSMPError
+  where
+    logSMPError :: ProtocolClientError -> ExceptT ProtocolClientError IO a
+    logSMPError e = do
+      liftIO $ putStrLn $ "SMP error (" <> show srv <> "): " <> show e
+      throwE e
+
+subscribeQueue :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateSignKey) -> ExceptT ProtocolClientError IO ()
+subscribeQueue ca srv sub = do
+  atomically $ addPendingSubscription ca srv sub
+  withSMP ca srv $ \smp -> subscribe_ smp `catchE` handleError
+  where
+    subscribe_ smp = do
+      smpSubscribe smp sub
+      atomically $ addSubscription ca srv sub
+
+    handleError e = do
+      atomically . when (e /= PCENetworkError && e /= PCEResponseTimeout) $
+        removePendingSubscription ca srv $ fst sub
+      throwE e
+
+showServer :: SMPServer -> ByteString
+showServer ProtocolServer {host, port} =
+  B.pack $ host <> if null port then "" else ':' : port
+
+smpSubscribe :: SMPClient -> (SMPSub, C.APrivateSignKey) -> ExceptT ProtocolClientError IO ()
+smpSubscribe smp ((party, queueId), privKey) = subscribe_ smp privKey queueId
+  where
+    subscribe_ = case party of
+      SPRecipient -> subscribeSMPQueue
+      SPNotifier -> subscribeSMPQueueNotifications
+
+addSubscription :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateSignKey) -> STM ()
+addSubscription ca srv sub = do
+  addSub_ (srvSubs ca) srv sub
+  removePendingSubscription ca srv $ fst sub
+
+addPendingSubscription :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateSignKey) -> STM ()
+addPendingSubscription = addSub_ . pendingSrvSubs
+
+addSub_ :: TMap SMPServer (TMap SMPSub C.APrivateSignKey) -> SMPServer -> (SMPSub, C.APrivateSignKey) -> STM ()
+addSub_ subs srv (s, key) =
+  TM.lookup srv subs >>= \case
+    Just m -> TM.insert s key m
+    _ -> TM.singleton s key >>= \v -> TM.insert srv v subs
+
+removeSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
+removeSubscription = removeSub_ . srvSubs
+
+removePendingSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
+removePendingSubscription = removeSub_ . pendingSrvSubs
+
+removeSub_ :: TMap SMPServer (TMap SMPSub C.APrivateSignKey) -> SMPServer -> SMPSub -> STM ()
+removeSub_ subs srv s = TM.lookup srv subs >>= mapM_ (TM.delete s)
+
+getSubKey :: TMap SMPServer (TMap SMPSub C.APrivateSignKey) -> SMPServer -> SMPSub -> STM (Maybe C.APrivateSignKey)
+getSubKey subs srv s = fmap join . mapM (TM.lookup s) =<< TM.lookup srv subs
+
+hasSub :: TMap SMPServer (TMap SMPSub C.APrivateSignKey) -> SMPServer -> SMPSub -> STM Bool
+hasSub subs srv s = maybe (pure False) (TM.member s) =<< TM.lookup srv subs
diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs
new file mode 100644
index 000000000..48fc89b1e
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Client.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Notifications.Client where
+
+import Control.Monad.Except
+import Control.Monad.Trans.Except
+import Data.Word (Word16)
+import Simplex.Messaging.Client
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Protocol
+
+type NtfClient = ProtocolClient NtfResponse
+
+registerNtfToken :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Token -> ExceptT ProtocolClientError IO (NtfTokenId, C.PublicKeyX25519)
+registerNtfToken c pKey newTkn =
+  sendNtfCommand c (Just pKey) "" (TNEW newTkn) >>= \case
+    NRId tknId dhKey -> pure (tknId, dhKey)
+    _ -> throwE PCEUnexpectedResponse
+
+verifyNtfToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> NtfRegistrationCode -> ExceptT ProtocolClientError IO ()
+verifyNtfToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
+
+deleteNtfToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> ExceptT ProtocolClientError IO ()
+deleteNtfToken = okNtfCommand TDEL
+
+enableNtfCron :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> Word16 -> ExceptT ProtocolClientError IO ()
+enableNtfCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
+
+createNtfSubsciption :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO (NtfSubscriptionId, C.PublicKeyX25519)
+createNtfSubsciption c pKey newSub =
+  sendNtfCommand c (Just pKey) "" (SNEW newSub) >>= \case
+    NRId tknId dhKey -> pure (tknId, dhKey)
+    _ -> throwE PCEUnexpectedResponse
+
+checkNtfSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO NtfSubStatus
+checkNtfSubscription c pKey subId =
+  sendNtfCommand c (Just pKey) subId SCHK >>= \case
+    NRStat stat -> pure stat
+    _ -> throwE PCEUnexpectedResponse
+
+deleteNfgSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO ()
+deleteNfgSubscription = okNtfCommand SDEL
+
+-- | Send notification server command
+sendNtfCommand :: NtfEntityI e => NtfClient -> Maybe C.APrivateSignKey -> NtfEntityId -> NtfCommand e -> ExceptT ProtocolClientError IO NtfResponse
+sendNtfCommand c pKey entId = sendProtocolCommand c pKey entId . NtfCmd sNtfEntity
+
+okNtfCommand :: NtfEntityI e => NtfCommand e -> NtfClient -> C.APrivateSignKey -> NtfEntityId -> ExceptT ProtocolClientError IO ()
+okNtfCommand cmd c pKey entId =
+  sendNtfCommand c (Just pKey) entId cmd >>= \case
+    NROk -> return ()
+    _ -> throwE PCEUnexpectedResponse
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index da66280fd..1fac10e7e 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -1,6 +1,11 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Simplex.Messaging.Notifications.Protocol where
@@ -8,154 +13,333 @@ module Simplex.Messaging.Notifications.Protocol where
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Kind
 import Data.Maybe (isNothing)
+import Data.Type.Equality
+import Data.Word (Word16)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Protocol
+import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
+import Simplex.Messaging.Util ((<$?>))
 
-data NtfCommandTag
-  = NCCreate_
-  | NCCheck_
-  | NCToken_
-  | NCDelete_
+data NtfEntity = Token | Subscription
   deriving (Show)
 
-instance Encoding NtfCommandTag where
+data SNtfEntity :: NtfEntity -> Type where
+  SToken :: SNtfEntity 'Token
+  SSubscription :: SNtfEntity 'Subscription
+
+instance TestEquality SNtfEntity where
+  testEquality SToken SToken = Just Refl
+  testEquality SSubscription SSubscription = Just Refl
+  testEquality _ _ = Nothing
+
+deriving instance Show (SNtfEntity e)
+
+class NtfEntityI (e :: NtfEntity) where sNtfEntity :: SNtfEntity e
+
+instance NtfEntityI 'Token where sNtfEntity = SToken
+
+instance NtfEntityI 'Subscription where sNtfEntity = SSubscription
+
+data NtfCommandTag (e :: NtfEntity) where
+  TNEW_ :: NtfCommandTag 'Token
+  TVFY_ :: NtfCommandTag 'Token
+  TDEL_ :: NtfCommandTag 'Token
+  TCRN_ :: NtfCommandTag 'Token
+  SNEW_ :: NtfCommandTag 'Subscription
+  SCHK_ :: NtfCommandTag 'Subscription
+  SDEL_ :: NtfCommandTag 'Subscription
+  PING_ :: NtfCommandTag 'Subscription
+
+deriving instance Show (NtfCommandTag e)
+
+data NtfCmdTag = forall e. NtfEntityI e => NCT (SNtfEntity e) (NtfCommandTag e)
+
+instance NtfEntityI e => Encoding (NtfCommandTag e) where
   smpEncode = \case
-    NCCreate_ -> "CREATE"
-    NCCheck_ -> "CHECK"
-    NCToken_ -> "TOKEN"
-    NCDelete_ -> "DELETE"
+    TNEW_ -> "TNEW"
+    TVFY_ -> "TVFY"
+    TDEL_ -> "TDEL"
+    TCRN_ -> "TCRN"
+    SNEW_ -> "SNEW"
+    SCHK_ -> "SCHK"
+    SDEL_ -> "SDEL"
+    PING_ -> "PING"
   smpP = messageTagP
 
-instance ProtocolMsgTag NtfCommandTag where
+instance Encoding NtfCmdTag where
+  smpEncode (NCT _ t) = smpEncode t
+  smpP = messageTagP
+
+instance ProtocolMsgTag NtfCmdTag where
   decodeTag = \case
-    "CREATE" -> Just NCCreate_
-    "CHECK" -> Just NCCheck_
-    "TOKEN" -> Just NCToken_
-    "DELETE" -> Just NCDelete_
+    "TNEW" -> Just $ NCT SToken TNEW_
+    "TVFY" -> Just $ NCT SToken TVFY_
+    "TDEL" -> Just $ NCT SToken TDEL_
+    "TCRN" -> Just $ NCT SToken TCRN_
+    "SNEW" -> Just $ NCT SSubscription SNEW_
+    "SCHK" -> Just $ NCT SSubscription SCHK_
+    "SDEL" -> Just $ NCT SSubscription SDEL_
+    "PING" -> Just $ NCT SSubscription PING_
     _ -> Nothing
 
-data NtfCommand
-  = NCCreate DeviceToken SMPQueueNtfUri C.APublicVerifyKey C.PublicKeyX25519
-  | NCCheck
-  | NCToken DeviceToken
-  | NCDelete
+instance NtfEntityI e => ProtocolMsgTag (NtfCommandTag e) where
+  decodeTag s = decodeTag s >>= (\(NCT _ t) -> checkEntity' t)
 
-instance Protocol NtfCommand where
-  type Tag NtfCommand = NtfCommandTag
+type NtfRegistrationCode = ByteString
+
+data NewNtfEntity (e :: NtfEntity) where
+  NewNtfTkn :: DeviceToken -> C.APublicVerifyKey -> C.PublicKeyX25519 -> NewNtfEntity 'Token
+  NewNtfSub :: NtfTokenId -> SMPQueueNtf -> NewNtfEntity 'Subscription
+
+data ANewNtfEntity = forall e. NtfEntityI e => ANE (SNtfEntity e) (NewNtfEntity e)
+
+instance NtfEntityI e => Encoding (NewNtfEntity e) where
+  smpEncode = \case
+    NewNtfTkn tkn verifyKey dhPubKey -> smpEncode ('T', tkn, verifyKey, dhPubKey)
+    NewNtfSub tknId smpQueue -> smpEncode ('S', tknId, smpQueue)
+  smpP = (\(ANE _ c) -> checkEntity c) <$?> smpP
+
+instance Encoding ANewNtfEntity where
+  smpEncode (ANE _ e) = smpEncode e
+  smpP =
+    A.anyChar >>= \case
+      'T' -> ANE SToken <$> (NewNtfTkn <$> smpP <*> smpP <*> smpP)
+      'S' -> ANE SSubscription <$> (NewNtfSub <$> smpP <*> smpP)
+      _ -> fail "bad ANewNtfEntity"
+
+instance Protocol NtfResponse where
+  type ProtocolCommand NtfResponse = NtfCmd
+  protocolPing = NtfCmd SSubscription PING
+  protocolError = \case
+    NRErr e -> Just e
+    _ -> Nothing
+
+data NtfCommand (e :: NtfEntity) where
+  -- | register new device token for notifications
+  TNEW :: NewNtfEntity 'Token -> NtfCommand 'Token
+  -- | verify token - uses e2e encrypted random string sent to the device via PN to confirm that the device has the token
+  TVFY :: NtfRegistrationCode -> NtfCommand 'Token
+  -- | delete token - all subscriptions will be removed and no more notifications will be sent
+  TDEL :: NtfCommand 'Token
+  -- | enable periodic background notification to fetch the new messages - interval is in minutes, minimum is 20, 0 to disable
+  TCRN :: Word16 -> NtfCommand 'Token
+  -- | create SMP subscription
+  SNEW :: NewNtfEntity 'Subscription -> NtfCommand 'Subscription
+  -- | check SMP subscription status (response is STAT)
+  SCHK :: NtfCommand 'Subscription
+  -- | delete SMP subscription
+  SDEL :: NtfCommand 'Subscription
+  -- | keep-alive command
+  PING :: NtfCommand 'Subscription
+
+data NtfCmd = forall e. NtfEntityI e => NtfCmd (SNtfEntity e) (NtfCommand e)
+
+instance NtfEntityI e => ProtocolEncoding (NtfCommand e) where
+  type Tag (NtfCommand e) = NtfCommandTag e
   encodeProtocol = \case
-    NCCreate token smpQueue verifyKey dhKey -> e (NCCreate_, ' ', token, smpQueue, verifyKey, dhKey)
-    NCCheck -> e NCCheck_
-    NCToken token -> e (NCToken_, ' ', token)
-    NCDelete -> e NCDelete_
+    TNEW newTkn -> e (TNEW_, ' ', newTkn)
+    TVFY code -> e (TVFY_, ' ', code)
+    TDEL -> e TDEL_
+    TCRN int -> e (TCRN_, ' ', int)
+    SNEW newSub -> e (SNEW_, ' ', newSub)
+    SCHK -> e SCHK_
+    SDEL -> e SDEL_
+    PING -> e PING_
     where
       e :: Encoding a => a -> ByteString
       e = smpEncode
 
-  protocolP = \case
-    NCCreate_ -> NCCreate <$> _smpP <*> smpP <*> smpP <*> smpP
-    NCCheck_ -> pure NCCheck
-    NCToken_ -> NCToken <$> _smpP
-    NCDelete_ -> pure NCDelete
+  protocolP tag = (\(NtfCmd _ c) -> checkEntity c) <$?> protocolP (NCT (sNtfEntity @e) tag)
 
-  checkCredentials (sig, _, subId, _) cmd = case cmd of
-    -- CREATE must have signature but NOT subscription ID
-    NCCreate {}
-      | isNothing sig -> Left $ CMD NO_AUTH
-      | not (B.null subId) -> Left $ CMD HAS_AUTH
-      | otherwise -> Right cmd
-    -- other client commands must have both signature and subscription ID
+  checkCredentials (sig, _, entityId, _) cmd = case cmd of
+    -- TNEW and SNEW must have signature but NOT token/subscription IDs
+    TNEW {} -> sigNoEntity
+    SNEW {} -> sigNoEntity
+    PING
+      | isNothing sig && B.null entityId -> Right cmd
+      | otherwise -> Left $ CMD HAS_AUTH
+    -- other client commands must have both signature and entity ID
     _
-      | isNothing sig || B.null subId -> Left $ CMD NO_AUTH
+      | isNothing sig || B.null entityId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
+    where
+      sigNoEntity
+        | isNothing sig = Left $ CMD NO_AUTH
+        | not (B.null entityId) = Left $ CMD HAS_AUTH
+        | otherwise = Right cmd
+
+instance ProtocolEncoding NtfCmd where
+  type Tag NtfCmd = NtfCmdTag
+  encodeProtocol (NtfCmd _ c) = encodeProtocol c
+
+  protocolP = \case
+    NCT SToken tag ->
+      NtfCmd SToken <$> case tag of
+        TNEW_ -> TNEW <$> _smpP
+        TVFY_ -> TVFY <$> _smpP
+        TDEL_ -> pure TDEL
+        TCRN_ -> TCRN <$> _smpP
+    NCT SSubscription tag ->
+      NtfCmd SSubscription <$> case tag of
+        SNEW_ -> SNEW <$> _smpP
+        SCHK_ -> pure SCHK
+        SDEL_ -> pure SDEL
+        PING_ -> pure PING
+
+  checkCredentials t (NtfCmd e c) = NtfCmd e <$> checkCredentials t c
 
 data NtfResponseTag
-  = NRSubId_
+  = NRId_
   | NROk_
   | NRErr_
   | NRStat_
+  | NRPong_
   deriving (Show)
 
 instance Encoding NtfResponseTag where
   smpEncode = \case
-    NRSubId_ -> "ID"
+    NRId_ -> "ID"
     NROk_ -> "OK"
     NRErr_ -> "ERR"
     NRStat_ -> "STAT"
+    NRPong_ -> "PONG"
   smpP = messageTagP
 
 instance ProtocolMsgTag NtfResponseTag where
   decodeTag = \case
-    "ID" -> Just NRSubId_
+    "ID" -> Just NRId_
     "OK" -> Just NROk_
     "ERR" -> Just NRErr_
     "STAT" -> Just NRStat_
+    "PONG" -> Just NRPong_
     _ -> Nothing
 
 data NtfResponse
-  = NRSubId C.PublicKeyX25519
+  = NRId NtfEntityId C.PublicKeyX25519
   | NROk
   | NRErr ErrorType
-  | NRStat NtfStatus
+  | NRStat NtfSubStatus
+  | NRPong
 
-instance Protocol NtfResponse where
+instance ProtocolEncoding NtfResponse where
   type Tag NtfResponse = NtfResponseTag
   encodeProtocol = \case
-    NRSubId dhKey -> e (NRSubId_, ' ', dhKey)
+    NRId entId dhKey -> e (NRId_, ' ', entId, dhKey)
     NROk -> e NROk_
     NRErr err -> e (NRErr_, ' ', err)
     NRStat stat -> e (NRStat_, ' ', stat)
+    NRPong -> e NRPong_
     where
       e :: Encoding a => a -> ByteString
       e = smpEncode
 
   protocolP = \case
-    NRSubId_ -> NRSubId <$> _smpP
+    NRId_ -> NRId <$> _smpP <*> smpP
     NROk_ -> pure NROk
     NRErr_ -> NRErr <$> _smpP
     NRStat_ -> NRStat <$> _smpP
+    NRPong_ -> pure NRPong
 
-  checkCredentials (_, _, subId, _) cmd = case cmd of
-    -- ERR response does not always have subscription ID
+  checkCredentials (_, _, entId, _) cmd = case cmd of
+    -- ID response must not have queue ID
+    NRId {} -> noEntity
+    -- ERR response does not always have entity ID
     NRErr _ -> Right cmd
-    -- other server responses must have subscription ID
+    -- PONG response must not have queue ID
+    NRPong -> noEntity
+    -- other server responses must have entity ID
     _
-      | B.null subId -> Left $ CMD NO_ENTITY
+      | B.null entId -> Left $ CMD NO_ENTITY
       | otherwise -> Right cmd
+    where
+      noEntity
+        | B.null entId = Right cmd
+        | otherwise = Left $ CMD HAS_AUTH
 
-data SMPQueueNtfUri = SMPQueueNtfUri
-  { smpServer :: SMPServer,
+data SMPQueueNtf = SMPQueueNtf
+  { smpServer :: ProtocolServer,
     notifierId :: NotifierId,
     notifierKey :: NtfPrivateSignKey
   }
 
-instance Encoding SMPQueueNtfUri where
-  smpEncode SMPQueueNtfUri {smpServer, notifierId, notifierKey} = smpEncode (smpServer, notifierId, notifierKey)
+instance Encoding SMPQueueNtf where
+  smpEncode SMPQueueNtf {smpServer, notifierId, notifierKey} = smpEncode (smpServer, notifierId, notifierKey)
   smpP = do
     (smpServer, notifierId, notifierKey) <- smpP
-    pure $ SMPQueueNtfUri smpServer notifierId notifierKey
+    pure $ SMPQueueNtf smpServer notifierId notifierKey
 
-newtype DeviceToken = DeviceToken ByteString
+data PushPlatform = PPApple
+
+instance Encoding PushPlatform where
+  smpEncode = \case
+    PPApple -> "A"
+  smpP =
+    A.anyChar >>= \case
+      'A' -> pure PPApple
+      _ -> fail "bad PushPlatform"
+
+data DeviceToken = DeviceToken PushPlatform ByteString
 
 instance Encoding DeviceToken where
-  smpEncode (DeviceToken t) = smpEncode t
-  smpP = DeviceToken <$> smpP
+  smpEncode (DeviceToken p t) = smpEncode (p, t)
+  smpP = DeviceToken <$> smpP <*> smpP
 
-type NtfSubsciptionId = ByteString
+type NtfEntityId = ByteString
 
-data NtfStatus = NSPending | NSActive | NSEnd | NSSMPAuth
+type NtfSubscriptionId = NtfEntityId
 
-instance Encoding NtfStatus where
+type NtfTokenId = NtfEntityId
+
+data NtfSubStatus
+  = -- | state after SNEW
+    NSNew
+  | -- | pending connection/subscription to SMP server
+    NSPending
+  | -- | connected and subscribed to SMP server
+    NSActive
+  | -- | NEND received (we currently do not support it)
+    NSEnd
+  | -- | SMP AUTH error
+    NSSMPAuth
+  deriving (Eq)
+
+instance Encoding NtfSubStatus where
   smpEncode = \case
-    NSPending -> "PENDING"
+    NSNew -> "NEW"
+    NSPending -> "PENDING" -- e.g. after SMP server disconnect/timeout while ntf server is retrying to connect
     NSActive -> "ACTIVE"
     NSEnd -> "END"
     NSSMPAuth -> "SMP_AUTH"
   smpP =
     A.takeTill (== ' ') >>= \case
+      "NEW" -> pure NSNew
       "PENDING" -> pure NSPending
       "ACTIVE" -> pure NSActive
       "END" -> pure NSEnd
       "SMP_AUTH" -> pure NSSMPAuth
       _ -> fail "bad NtfError"
+
+data NtfTknStatus
+  = -- | state after registration (TNEW)
+    NTNew
+  | -- | if initial notification or verification failed (push provider error)
+    NTInvalid
+  | -- | if initial notification succeeded
+    NTConfirmed
+  | -- | after successful verification (TVFY)
+    NTActive
+  | -- | after it is no longer valid (push provider error)
+    NTExpired
+  deriving (Eq)
+
+checkEntity :: forall t e e'. (NtfEntityI e, NtfEntityI e') => t e' -> Either String (t e)
+checkEntity c = case testEquality (sNtfEntity @e) (sNtfEntity @e') of
+  Just Refl -> Right c
+  Nothing -> Left "bad command party"
+
+checkEntity' :: forall t p p'. (NtfEntityI p, NtfEntityI p') => t p' -> Maybe (t p)
+checkEntity' c = case testEquality (sNtfEntity @p) (sNtfEntity @p') of
+  Just Refl -> Just c
+  _ -> Nothing
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index dfdaae801..13d4671e6 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -1,9 +1,12 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Notifications.Server where
 
@@ -12,13 +15,16 @@ import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
 import Data.ByteString.Char8 (ByteString)
+import Data.Functor (($>))
 import Network.Socket (ServiceName)
+import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Subscriptions
 import Simplex.Messaging.Notifications.Transport
-import Simplex.Messaging.Protocol (ErrorType (..), Transmission, encodeTransmission, tGet, tPut)
+import Simplex.Messaging.Protocol (ErrorType (..), SignedTransmission, Transmission, encodeTransmission, tGet, tPut)
+import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
 import Simplex.Messaging.Transport (ATransport (..), THandle (..), TProxy, Transport)
 import Simplex.Messaging.Transport.Server (runTransportServer)
@@ -37,7 +43,10 @@ runNtfServerBlocking started cfg@NtfServerConfig {transports} = do
   runReaderT ntfServer env
   where
     ntfServer :: (MonadUnliftIO m', MonadReader NtfEnv m') => m' ()
-    ntfServer = raceAny_ (map runServer transports)
+    ntfServer = do
+      s <- asks subscriber
+      ps <- asks pushServer
+      raceAny_ (ntfSubscriber s : ntfPush ps : map runServer transports)
 
     runServer :: (MonadUnliftIO m', MonadReader NtfEnv m') => (ServiceName, ATransport) -> m' ()
     runServer (tcpPort, ATransport t) = do
@@ -51,11 +60,61 @@ runNtfServerBlocking started cfg@NtfServerConfig {transports} = do
         Right th -> runNtfClientTransport th
         Left _ -> pure ()
 
+ntfSubscriber :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfSubscriber -> m ()
+ntfSubscriber NtfSubscriber {subQ, smpAgent = ca@SMPClientAgent {msgQ, agentQ}} = do
+  raceAny_ [subscribe, receiveSMP, receiveAgent]
+  where
+    subscribe :: m ()
+    subscribe = forever $ do
+      atomically (readTBQueue subQ) >>= \case
+        NtfSub NtfSubData {smpQueue} -> do
+          let SMPQueueNtf {smpServer, notifierId, notifierKey} = smpQueue
+          liftIO (runExceptT $ subscribeQueue ca smpServer ((SPNotifier, notifierId), notifierKey)) >>= \case
+            Right _ -> pure () -- update subscription status
+            Left e -> pure ()
+
+    receiveSMP :: m ()
+    receiveSMP = forever $ do
+      (srv, ntfId, msg) <- atomically $ readTBQueue msgQ
+      case msg of
+        SMP.NMSG -> do
+          -- check when the last NMSG was received from this queue
+          -- update timestamp
+          -- check what was the last hidden notification was sent (and whether to this queue)
+          -- decide whether it should be sent as hidden or visible
+          -- construct and possibly encrypt notification
+          -- send it
+          pure ()
+        _ -> pure ()
+      pure ()
+
+    receiveAgent =
+      forever $
+        atomically (readTBQueue agentQ) >>= \case
+          CAConnected _ -> pure ()
+          CADisconnected srv subs -> do
+            -- update subscription statuses
+            pure ()
+          CAReconnected _ -> pure ()
+          CAResubscribed srv sub -> do
+            -- update subscription status
+            pure ()
+          CASubError srv sub err -> do
+            -- update subscription status
+            pure ()
+
+ntfPush :: (MonadUnliftIO m, MonadReader NtfEnv m) => NtfPushServer -> m ()
+ntfPush NtfPushServer {pushQ} = forever $ do
+  atomically (readTBQueue pushQ) >>= \case
+    (NtfTknData {}, Notification {}) -> pure ()
+
 runNtfClientTransport :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> m ()
 runNtfClientTransport th@THandle {sessionId} = do
-  q <- asks $ tbqSize . config
-  c <- atomically $ newNtfServerClient q sessionId
-  raceAny_ [send th c, client c, receive th c]
+  qSize <- asks $ clientQSize . config
+  c <- atomically $ newNtfServerClient qSize sessionId
+  s <- asks subscriber
+  ps <- asks pushServer
+  raceAny_ [send th c, client c s ps, receive th c]
     `finally` clientDisconnected c
 
 clientDisconnected :: MonadUnliftIO m => NtfServerClient -> m ()
@@ -63,14 +122,13 @@ clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connecte
 
 receive :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> NtfServerClient -> m ()
 receive th NtfServerClient {rcvQ, sndQ} = forever $ do
-  (sig, signed, (corrId, queueId, cmdOrError)) <- tGet th
+  t@(sig, signed, (corrId, subId, cmdOrError)) <- tGet th
   case cmdOrError of
-    Left e -> write sndQ (corrId, queueId, NRErr e)
-    Right cmd -> do
-      verified <- verifyTransmission sig signed queueId cmd
-      if verified
-        then write rcvQ (corrId, queueId, cmd)
-        else write sndQ (corrId, queueId, NRErr AUTH)
+    Left e -> write sndQ (corrId, subId, NRErr e)
+    Right cmd ->
+      verifyNtfTransmission t cmd >>= \case
+        VRVerified req -> write rcvQ req
+        VRFailed -> write sndQ (corrId, subId, NRErr AUTH)
   where
     write q t = atomically $ writeTBQueue q t
 
@@ -79,33 +137,121 @@ send h NtfServerClient {sndQ, sessionId} = forever $ do
   t <- atomically $ readTBQueue sndQ
   liftIO $ tPut h (Nothing, encodeTransmission sessionId t)
 
-verifyTransmission ::
-  forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => Maybe C.ASignature -> ByteString -> NtfSubsciptionId -> NtfCommand -> m Bool
-verifyTransmission sig_ signed subId cmd = do
-  case cmd of
-    NCCreate _ _ k _ -> pure $ verifyCmdSignature sig_ signed k
-    _ -> do
-      st <- asks store
-      verifySubCmd <$> atomically (getNtfSubscription st subId)
-  where
-    verifySubCmd = \case
-      Right sub -> verifyCmdSignature sig_ signed $ subVerifyKey sub
-      Left _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` False
+data VerificationResult = VRVerified NtfRequest | VRFailed
 
-client :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfServerClient -> m ()
-client NtfServerClient {rcvQ, sndQ} =
+verifyNtfTransmission ::
+  forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => SignedTransmission NtfCmd -> NtfCmd -> m VerificationResult
+verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do
+  case cmd of
+    NtfCmd SToken (TNEW n@(NewNtfTkn _ k _)) ->
+      -- TODO check that token is not already in store
+      pure $
+        if verifyCmdSignature sig_ signed k
+          then VRVerified (NtfReqNew corrId (ANE SToken n))
+          else VRFailed
+    NtfCmd SToken c -> do
+      st <- asks store
+      atomically (getNtfToken st entId) >>= \case
+        Just r@(NtfTkn NtfTknData {tknVerifyKey}) ->
+          pure $
+            if verifyCmdSignature sig_ signed tknVerifyKey
+              then VRVerified (NtfReqCmd SToken r (corrId, entId, c))
+              else VRFailed
+        _ -> pure VRFailed -- TODO dummy verification
+    _ -> pure VRFailed
+
+-- do
+--   st <- asks store
+--   case cmd of
+--     NCSubCreate tokenId smpQueue -> verifyCreateCmd verifyKey newSub <$> atomically (getNtfSubViaSMPQueue st smpQueue)
+--     _ -> verifySubCmd <$> atomically (getNtfSub st subId)
+--   where
+--     verifyCreateCmd k newSub sub_
+--       | verifyCmdSignature sig_ signed k = case sub_ of
+--         Just sub -> if k == subVerifyKey sub then VRCommand sub else VRFail
+--         _ -> VRCreate newSub
+--       | otherwise = VRFail
+--     verifySubCmd = \case
+--       Just sub -> if verifyCmdSignature sig_ signed $ subVerifyKey sub then VRCommand sub else VRFail
+--       _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` VRFail
+
+client :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfServerClient -> NtfSubscriber -> NtfPushServer -> m ()
+client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ} NtfPushServer {pushQ} =
   forever $
     atomically (readTBQueue rcvQ)
       >>= processCommand
       >>= atomically . writeTBQueue sndQ
   where
-    processCommand :: Transmission NtfCommand -> m (Transmission NtfResponse)
-    processCommand (corrId, subId, cmd) = case cmd of
-      NCCreate _token _smpQueue _verifyKey _dhKey -> do
-        pure (corrId, subId, NROk)
-      NCCheck -> do
-        pure (corrId, subId, NROk)
-      NCToken _token -> do
-        pure (corrId, subId, NROk)
-      NCDelete -> do
-        pure (corrId, subId, NROk)
+    processCommand :: NtfRequest -> m (Transmission NtfResponse)
+    processCommand = \case
+      NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn _ _ dhPubKey)) -> do
+        st <- asks store
+        (srvDhPubKey, srvDrivDhKey) <- liftIO C.generateKeyPair'
+        let dhSecret = C.dh' dhPubKey srvDrivDhKey
+        tknId <- getId
+        atomically $ do
+          tkn <- mkNtfTknData newTkn dhSecret
+          addNtfToken st tknId tkn
+          writeTBQueue pushQ (tkn, Notification)
+        --     pure (corrId, sId, NRSubId pubDhKey)
+        pure (corrId, "", NRId tknId srvDhPubKey)
+      NtfReqCmd SToken tkn (corrId, tknId, cmd) ->
+        (corrId,tknId,) <$> case cmd of
+          TNEW newTkn -> pure NROk -- TODO when duplicate token sent
+          TVFY code -> pure NROk
+          TDEL -> pure NROk
+          TCRN int -> pure NROk
+      NtfReqNew corrId (ANE SSubscription newSub) -> pure (corrId, "", NROk)
+      NtfReqCmd SSubscription sub (corrId, subId, cmd) ->
+        (corrId,subId,) <$> case cmd of
+          SNEW newSub -> pure NROk
+          SCHK -> pure NROk
+          SDEL -> pure NROk
+          PING -> pure NRPong
+    getId :: m NtfEntityId
+    getId = do
+      n <- asks $ subIdBytes . config
+      gVar <- asks idsDrg
+      atomically (randomBytes n gVar)
+
+-- NReqCreate corrId tokenId smpQueue -> pure (corrId, "", NROk)
+-- do
+-- st <- asks store
+-- (pubDhKey, privDhKey) <- liftIO C.generateKeyPair'
+-- let dhSecret = C.dh' dhPubKey privDhKey
+-- sub <- atomically $ mkNtfSubsciption smpQueue token verifyKey dhSecret
+-- addSubRetry 3 st sub >>= \case
+--   Nothing -> pure (corrId, "", NRErr INTERNAL)
+--   Just sId -> do
+--     atomically $ writeTBQueue subQ sub
+--     pure (corrId, sId, NRSubId pubDhKey)
+-- where
+--   addSubRetry :: Int -> NtfSubscriptionsStore -> NtfSubsciption -> m (Maybe NtfSubsciptionId)
+--   addSubRetry 0 _ _ = pure Nothing
+--   addSubRetry n st sub = do
+--     sId <- getId
+--     -- create QueueRec record with these ids and keys
+--     atomically (addNtfSub st sId sub) >>= \case
+--       Nothing -> addSubRetry (n - 1) st sub
+--       _ -> pure $ Just sId
+--   getId :: m NtfSubsciptionId
+--   getId = do
+--     n <- asks $ subIdBytes . config
+--     gVar <- asks idsDrg
+--     atomically (randomBytes n gVar)
+-- NReqCommand sub@NtfSubsciption {tokenId, subStatus} (corrId, subId, cmd) ->
+--   (corrId,subId,) <$> case cmd of
+--     NCSubCreate tokenId smpQueue -> pure NROk
+-- do
+--   st <- asks store
+--   (pubDhKey, privDhKey) <- liftIO C.generateKeyPair'
+--   let dhSecret = C.dh' (dhPubKey newSub) privDhKey
+--   atomically (updateNtfSub st sub newSub dhSecret) >>= \case
+--     Nothing -> pure $ NRErr INTERNAL
+--     _ -> atomically $ do
+--       whenM ((== NSEnd) <$> readTVar status) $ writeTBQueue subQ sub
+--       pure $ NRSubId pubDhKey
+-- NCSubCheck -> NRStat <$> readTVarIO subStatus
+-- NCSubDelete -> do
+--   st <- asks store
+--   atomically (deleteNtfSub st subId) $> NROk
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 3ce4d2b8d..fec2aafb6 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -1,4 +1,7 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Messaging.Notifications.Server.Env where
@@ -6,26 +9,27 @@ module Simplex.Messaging.Notifications.Server.Env where
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.Map.Strict as M
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket
 import qualified Network.TLS as T
 import Numeric.Natural
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Client
+import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Subscriptions
-import Simplex.Messaging.Protocol (Transmission)
+import Simplex.Messaging.Protocol (CorrId, Transmission)
 import Simplex.Messaging.Transport (ATransport)
 import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
 import UnliftIO.STM
 
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ATransport)],
-    subscriptionIdBytes :: Int,
-    tbqSize :: Natural,
-    smpCfg :: SMPClientConfig,
+    subIdBytes :: Int,
+    clientQSize :: Natural,
+    subQSize :: Natural,
+    pushQSize :: Natural,
+    smpAgentCfg :: SMPClientAgentConfig,
     reconnectInterval :: RetryInterval,
     -- CA certificate private key is not needed for initialization
     caCertificateFile :: FilePath,
@@ -33,26 +37,55 @@ data NtfServerConfig = NtfServerConfig
     certificateFile :: FilePath
   }
 
+data Notification = Notification
+
 data NtfEnv = NtfEnv
   { config :: NtfServerConfig,
-    serverIdentity :: C.KeyHash,
-    store :: NtfSubscriptions,
+    subscriber :: NtfSubscriber,
+    pushServer :: NtfPushServer,
+    store :: NtfStore,
     idsDrg :: TVar ChaChaDRG,
+    serverIdentity :: C.KeyHash,
     tlsServerParams :: T.ServerParams,
     serverIdentity :: C.KeyHash
   }
 
 newNtfServerEnv :: (MonadUnliftIO m, MonadRandom m) => NtfServerConfig -> m NtfEnv
-newNtfServerEnv config@NtfServerConfig {caCertificateFile, certificateFile, privateKeyFile} = do
+newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, caCertificateFile, certificateFile, privateKeyFile} = do
   idsDrg <- newTVarIO =<< drgNew
-  store <- newTVarIO M.empty
+  store <- atomically newNtfStore
+  subscriber <- atomically $ newNtfSubscriber subQSize smpAgentCfg
+  pushServer <- atomically $ newNtfPushServer pushQSize
   tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
   Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
-  let serverIdentity = C.KeyHash fp
-  pure NtfEnv {config, store, idsDrg, tlsServerParams, serverIdentity}
+  pure NtfEnv {config, subscriber, pushServer, store, idsDrg, tlsServerParams, serverIdentity = C.KeyHash fp}
+
+data NtfSubscriber = NtfSubscriber
+  { subQ :: TBQueue (NtfEntityRec 'Subscription),
+    smpAgent :: SMPClientAgent
+  }
+
+newNtfSubscriber :: Natural -> SMPClientAgentConfig -> STM NtfSubscriber
+newNtfSubscriber qSize smpAgentCfg = do
+  smpAgent <- newSMPClientAgent smpAgentCfg
+  subQ <- newTBQueue qSize
+  pure NtfSubscriber {smpAgent, subQ}
+
+newtype NtfPushServer = NtfPushServer
+  { pushQ :: TBQueue (NtfTknData, Notification)
+  }
+
+newNtfPushServer :: Natural -> STM NtfPushServer
+newNtfPushServer qSize = do
+  pushQ <- newTBQueue qSize
+  pure NtfPushServer {pushQ}
+
+data NtfRequest
+  = NtfReqNew CorrId ANewNtfEntity
+  | forall e. NtfEntityI e => NtfReqCmd (SNtfEntity e) (NtfEntityRec e) (Transmission (NtfCommand e))
 
 data NtfServerClient = NtfServerClient
-  { rcvQ :: TBQueue (Transmission NtfCommand),
+  { rcvQ :: TBQueue NtfRequest,
     sndQ :: TBQueue (Transmission NtfResponse),
     sessionId :: ByteString,
     connected :: TVar Bool
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
new file mode 100644
index 000000000..87b475f2a
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -0,0 +1,11 @@
+module Simplex.Messaging.Notifications.Server.Push where
+
+import Control.Concurrent.STM
+import Data.ByteString.Char8 (ByteString)
+import Simplex.Messaging.Protocol (NotifierId, SMPServer)
+
+data NtfPushPayload = NPVerification ByteString | NPNotification SMPServer NotifierId | NPPing
+
+class PushProvider p where
+  newPushProvider :: STM p
+  requestBody :: p -> NtfPushPayload -> ByteString -- ?
diff --git a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
index 5658e336a..e5cbd26fc 100644
--- a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
@@ -1,25 +1,109 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TupleSections #-}
+
 module Simplex.Messaging.Notifications.Server.Subscriptions where
 
 import Control.Concurrent.STM
+import Control.Monad
+import Crypto.PubKey.Curve25519 (dhSecret)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.Set (Set)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Protocol (ErrorType (..), NotifierId, NtfPrivateSignKey, SMPServer)
+import Simplex.Messaging.Protocol (ErrorType (..), NotifierId, NtfPrivateSignKey, ProtocolServer)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util ((<$$>))
 
-type NtfSubscriptionsData = Map NtfSubsciptionId NtfSubsciptionRec
-
-type NtfSubscriptions = TVar NtfSubscriptionsData
-
-data NtfSubsciptionRec = NtfSubsciptionRec
-  { smpServer :: SMPServer,
-    notifierId :: NotifierId,
-    notifierKey :: NtfPrivateSignKey,
-    token :: DeviceToken,
-    status :: TVar NtfStatus,
-    subVerifyKey :: C.APublicVerifyKey,
-    subDHSecret :: C.DhSecretX25519
+data NtfStore = NtfStore
+  { tokens :: TMap NtfTokenId NtfTknData,
+    tokenIds :: TMap DeviceToken NtfTokenId
   }
 
-getNtfSubscription :: NtfSubscriptions -> NtfSubsciptionId -> STM (Either ErrorType NtfSubsciptionRec)
-getNtfSubscription st subId = maybe (Left AUTH) Right . M.lookup subId <$> readTVar st
+newNtfStore :: STM NtfStore
+newNtfStore = do
+  tokens <- TM.empty
+  tokenIds <- TM.empty
+  pure NtfStore {tokens, tokenIds}
+
+data NtfTknData = NtfTknData
+  { token :: DeviceToken,
+    tknStatus :: TVar NtfTknStatus,
+    tknVerifyKey :: C.APublicVerifyKey,
+    tknDhSecret :: C.DhSecretX25519
+  }
+
+mkNtfTknData :: NewNtfEntity 'Token -> C.DhSecretX25519 -> STM NtfTknData
+mkNtfTknData (NewNtfTkn token tknVerifyKey _) tknDhSecret = do
+  tknStatus <- newTVar NTNew
+  pure NtfTknData {token, tknStatus, tknVerifyKey, tknDhSecret}
+
+data NtfSubscriptionsStore = NtfSubscriptionsStore
+
+-- { subscriptions :: TMap NtfSubsciptionId NtfSubsciption,
+--   activeSubscriptions :: TMap (SMPServer, NotifierId) NtfSubsciptionId
+-- }
+-- do
+-- subscriptions <- newTVar M.empty
+-- activeSubscriptions <- newTVar M.empty
+-- pure NtfSubscriptionsStore {subscriptions, activeSubscriptions}
+
+data NtfSubData = NtfSubData
+  { smpQueue :: SMPQueueNtf,
+    tokenId :: NtfTokenId,
+    subStatus :: TVar NtfSubStatus
+  }
+
+data NtfEntityRec (e :: NtfEntity) where
+  NtfTkn :: NtfTknData -> NtfEntityRec 'Token
+  NtfSub :: NtfSubData -> NtfEntityRec 'Subscription
+
+data ANtfEntityRec = forall e. NtfEntityI e => NER (SNtfEntity e) (NtfEntityRec e)
+
+getNtfToken :: NtfStore -> NtfTokenId -> STM (Maybe (NtfEntityRec 'Token))
+getNtfToken st tknId = NtfTkn <$$> TM.lookup tknId (tokens st)
+
+addNtfToken :: NtfStore -> NtfTokenId -> NtfTknData -> STM ()
+addNtfToken st tknId tkn = pure ()
+
+-- getNtfRec :: NtfStore -> SNtfEntity e -> NtfEntityId -> STM (Maybe (NtfEntityRec e))
+-- getNtfRec st ent entId = case ent of
+--   SToken -> NtfTkn <$$> TM.lookup entId (tokens st)
+--   SSubscription -> pure Nothing
+
+-- getNtfVerifyKey :: NtfStore -> SNtfEntity e -> NtfEntityId -> STM (Maybe (NtfEntityRec e, C.APublicVerifyKey))
+-- getNtfVerifyKey st ent entId =
+--   getNtfRec st ent entId >>= \case
+--     Just r@(NtfTkn NtfTknData {tknVerifyKey}) -> pure $ Just (r, tknVerifyKey)
+--     Just r@(NtfSub NtfSubData {tokenId}) ->
+--       getNtfRec st SToken tokenId >>= \case
+--         Just (NtfTkn NtfTknData {tknVerifyKey}) -> pure $ Just (r, tknVerifyKey)
+--         _ -> pure Nothing
+--     _ -> pure Nothing
+
+-- mkNtfSubsciption :: SMPQueueNtf -> NtfTokenId -> STM NtfSubsciption
+-- mkNtfSubsciption smpQueue tokenId = do
+--   subStatus <- newTVar NSNew
+--   pure NtfSubsciption {smpQueue, tokenId, subStatus}
+
+-- getNtfSub :: NtfSubscriptionsStore -> NtfSubsciptionId -> STM (Maybe NtfSubsciption)
+-- getNtfSub st subId = pure Nothing -- maybe (pure $ Left AUTH) (fmap Right . readTVar) . M.lookup subId . subscriptions =<< readTVar st
+
+-- getNtfSubViaSMPQueue :: NtfSubscriptionsStore -> SMPQueueNtf -> STM (Maybe NtfSubsciption)
+-- getNtfSubViaSMPQueue st smpQueue = pure Nothing
+
+-- -- replace keeping status
+-- updateNtfSub :: NtfSubscriptionsStore -> NtfSubsciption -> SMPQueueNtf -> NtfTokenId -> C.DhSecretX25519 -> STM (Maybe ())
+-- updateNtfSub st sub smpQueue tokenId dhSecret = pure Nothing
+
+-- addNtfSub :: NtfSubscriptionsStore -> NtfSubsciptionId -> NtfSubsciption -> STM (Maybe ())
+-- addNtfSub st subId sub = pure Nothing
+
+-- deleteNtfSub :: NtfSubscriptionsStore -> NtfSubsciptionId -> STM ()
+-- deleteNtfSub st subId = pure ()
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index dbe5a98a0..0e94b5192 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -1,23 +1,25 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 -- |
--- Module      : Simplex.Messaging.Protocol
+-- Module      : Simplex.Messaging.ProtocolEncoding
 -- Copyright   : (c) simplex.chat
 -- License     : AGPL-3
 --
@@ -37,7 +39,7 @@ module Simplex.Messaging.Protocol
     e2eEncMessageLength,
 
     -- * SMP protocol types
-    Protocol (..),
+    ProtocolEncoding (..),
     Command (..),
     Party (..),
     Cmd (..),
@@ -55,7 +57,10 @@ module Simplex.Messaging.Protocol
     PubHeader (..),
     ClientMessage (..),
     PrivHeader (..),
-    SMPServer (..),
+    Protocol (..),
+    ProtocolServer (..),
+    SMPServer,
+    pattern SMPServer,
     SrvLoc (..),
     CorrId (..),
     QueueId,
@@ -163,7 +168,7 @@ data Cmd = forall p. PartyI p => Cmd (SParty p) (Command p)
 deriving instance Show Cmd
 
 -- | Parsed SMP transmission without signature, size and session ID.
-type Transmission c = (CorrId, QueueId, c)
+type Transmission c = (CorrId, EntityId, c)
 
 -- | signed parsed transmission, with original raw bytes and parsing error.
 type SignedTransmission c = (Maybe C.ASignature, Signed, Transmission (Either ErrorType c))
@@ -196,7 +201,9 @@ type SenderId = QueueId
 type NotifierId = QueueId
 
 -- | SMP queue ID on the server.
-type QueueId = ByteString
+type QueueId = EntityId
+
+type EntityId = ByteString
 
 -- | Parameterized type for SMP protocol commands from all clients.
 data Command (p :: Party) where
@@ -266,7 +273,7 @@ class ProtocolMsgTag t where
 
 messageTagP :: ProtocolMsgTag t => Parser t
 messageTagP =
-  maybe (fail "bad command") pure . decodeTag
+  maybe (fail "bad message") pure . decodeTag
     =<< (A.takeTill (== ' ') <* optional A.space)
 
 instance PartyI p => Encoding (CommandTag p) where
@@ -374,34 +381,39 @@ instance Encoding ClientMessage where
   smpEncode (ClientMessage h msg) = smpEncode h <> msg
   smpP = ClientMessage <$> smpP <*> A.takeByteString
 
+type SMPServer = ProtocolServer
+
+pattern SMPServer :: HostName -> ServiceName -> C.KeyHash -> ProtocolServer
+pattern SMPServer host port keyHash = ProtocolServer host port keyHash
+
 -- | SMP server location and transport key digest (hash).
-data SMPServer = SMPServer
+data ProtocolServer = ProtocolServer
   { host :: HostName,
     port :: ServiceName,
     keyHash :: C.KeyHash
   }
   deriving (Eq, Ord, Show)
 
-instance IsString SMPServer where
+instance IsString ProtocolServer where
   fromString = parseString strDecode
 
-instance Encoding SMPServer where
-  smpEncode SMPServer {host, port, keyHash} =
+instance Encoding ProtocolServer where
+  smpEncode ProtocolServer {host, port, keyHash} =
     smpEncode (host, port, keyHash)
   smpP = do
     (host, port, keyHash) <- smpP
-    pure SMPServer {host, port, keyHash}
+    pure ProtocolServer {host, port, keyHash}
 
-instance StrEncoding SMPServer where
-  strEncode SMPServer {host, port, keyHash} =
+instance StrEncoding ProtocolServer where
+  strEncode ProtocolServer {host, port, keyHash} =
     "smp://" <> strEncode keyHash <> "@" <> strEncode (SrvLoc host port)
   strP = do
     _ <- "smp://"
     keyHash <- strP <* A.char '@'
     SrvLoc host port <- strP
-    pure SMPServer {host, port, keyHash}
+    pure ProtocolServer {host, port, keyHash}
 
-instance ToJSON SMPServer where
+instance ToJSON ProtocolServer where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
@@ -540,13 +552,25 @@ transmissionP = do
       command <- A.takeByteString
       pure RawTransmission {signature, signed, sessId, corrId, entityId, command}
 
-class Protocol msg where
+class (ProtocolEncoding msg, ProtocolEncoding (ProtocolCommand msg)) => Protocol msg where
+  type ProtocolCommand msg = cmd | cmd -> msg
+  protocolPing :: ProtocolCommand msg
+  protocolError :: msg -> Maybe ErrorType
+
+instance Protocol BrokerMsg where
+  type ProtocolCommand BrokerMsg = Cmd
+  protocolPing = Cmd SSender PING
+  protocolError = \case
+    ERR e -> Just e
+    _ -> Nothing
+
+class ProtocolMsgTag (Tag msg) => ProtocolEncoding msg where
   type Tag msg
   encodeProtocol :: msg -> ByteString
   protocolP :: Tag msg -> Parser msg
   checkCredentials :: SignedRawTransmission -> msg -> Either ErrorType msg
 
-instance PartyI p => Protocol (Command p) where
+instance PartyI p => ProtocolEncoding (Command p) where
   type Tag (Command p) = CommandTag p
   encodeProtocol = \case
     NEW rKey dhKey -> e (NEW_, ' ', rKey, dhKey)
@@ -584,7 +608,7 @@ instance PartyI p => Protocol (Command p) where
       | isNothing sig || B.null queueId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
 
-instance Protocol Cmd where
+instance ProtocolEncoding Cmd where
   type Tag Cmd = CmdTag
   encodeProtocol (Cmd _ c) = encodeProtocol c
 
@@ -606,7 +630,7 @@ instance Protocol Cmd where
 
   checkCredentials t (Cmd p c) = Cmd p <$> checkCredentials t c
 
-instance Protocol BrokerMsg where
+instance ProtocolEncoding BrokerMsg where
   type Tag BrokerMsg = BrokerMsgTag
   encodeProtocol = \case
     IDS (QIK rcvId sndId srvDh) -> e (IDS_, ' ', rcvId, sndId, srvDh)
@@ -632,7 +656,7 @@ instance Protocol BrokerMsg where
     PONG_ -> pure PONG
 
   checkCredentials (_, _, queueId, _) cmd = case cmd of
-    -- IDS response must not have queue ID
+    -- IDS response should not have queue ID
     IDS _ -> Right cmd
     -- ERR response does not always have queue ID
     ERR _ -> Right cmd
@@ -649,7 +673,7 @@ _smpP :: Encoding a => Parser a
 _smpP = A.space *> smpP
 
 -- | Parse SMP protocol commands and broker messages
-parseProtocol :: (Protocol msg, ProtocolMsgTag (Tag msg)) => ByteString -> Either ErrorType msg
+parseProtocol :: ProtocolEncoding msg => ByteString -> Either ErrorType msg
 parseProtocol s =
   let (tag, params) = B.break (== ' ') s
    in case decodeTag tag of
@@ -712,7 +736,7 @@ instance Encoding CommandError where
 tPut :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
 tPut th (sig, t) = tPutBlock th $ smpEncode (C.signatureBytes sig) <> t
 
-encodeTransmission :: Protocol c => ByteString -> Transmission c -> ByteString
+encodeTransmission :: ProtocolEncoding c => ByteString -> Transmission c -> ByteString
 encodeTransmission sessionId (CorrId corrId, queueId, command) =
   smpEncode (sessionId, corrId, queueId) <> encodeProtocol command
 
@@ -721,11 +745,7 @@ tGetParse :: Transport c => THandle c -> IO (Either TransportError RawTransmissi
 tGetParse th = (parse transmissionP TEBadBlock =<<) <$> tGetBlock th
 
 -- | Receive client and server transmissions (determined by `cmd` type).
-tGet ::
-  forall cmd c m.
-  (Protocol cmd, ProtocolMsgTag (Tag cmd), Transport c, MonadIO m) =>
-  THandle c ->
-  m (SignedTransmission cmd)
+tGet :: forall cmd c m. (ProtocolEncoding cmd, Transport c, MonadIO m) => THandle c -> m (SignedTransmission cmd)
 tGet th@THandle {sessionId} = liftIO (tGetParse th) >>= decodeParseValidate
   where
     decodeParseValidate :: Either TransportError RawTransmission -> m (SignedTransmission cmd)
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index c76a2aaa3..c3d62bb02 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -23,7 +23,7 @@
 -- and optional append only log of SMP queue records.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
-module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking, verifyCmdSignature, dummyVerifyCmd) where
+module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking, verifyCmdSignature, dummyVerifyCmd, randomBytes) where
 
 import Control.Monad
 import Control.Monad.Except
diff --git a/src/Simplex/Messaging/TMap.hs b/src/Simplex/Messaging/TMap.hs
index a6584903e..b5bc01253 100644
--- a/src/Simplex/Messaging/TMap.hs
+++ b/src/Simplex/Messaging/TMap.hs
@@ -11,6 +11,7 @@ module Simplex.Messaging.TMap
     adjust,
     update,
     alter,
+    alterF,
     union,
   )
 where
@@ -65,6 +66,12 @@ alter :: Ord k => (Maybe a -> Maybe a) -> k -> TMap k a -> STM ()
 alter f k m = modifyTVar' m $ M.alter f k
 {-# INLINE alter #-}
 
+alterF :: Ord k => (Maybe a -> STM (Maybe a)) -> k -> TMap k a -> STM ()
+alterF f k m = do
+  mv <- M.alterF f k =<< readTVar m
+  writeTVar m $! mv
+{-# INLINE alterF #-}
+
 union :: Ord k => Map k a -> TMap k a -> STM ()
 union m' m = modifyTVar' m $ M.union m'
 {-# INLINE union #-}
diff --git a/src/Simplex/Messaging/Transport/KeepAlive.hs b/src/Simplex/Messaging/Transport/KeepAlive.hs
index aa308492d..c949394a0 100644
--- a/src/Simplex/Messaging/Transport/KeepAlive.hs
+++ b/src/Simplex/Messaging/Transport/KeepAlive.hs
@@ -52,7 +52,7 @@ foreign import capi "netinet/tcp.h value TCP_KEEPINTVL" _TCP_KEEPINTVL :: CInt
 
 foreign import capi "netinet/tcp.h value TCP_KEEPCNT" _TCP_KEEPCNT :: CInt
 
-#endif 
+#endif
 
 setSocketKeepAlive :: Socket -> KeepAliveOpts -> IO ()
 setSocketKeepAlive sock KeepAliveOpts {keepCnt, keepIdle, keepIntvl} = do
diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs
index cbab22793..1b1598413 100644
--- a/tests/AgentTests/ConnectionRequestTests.hs
+++ b/tests/AgentTests/ConnectionRequestTests.hs
@@ -11,7 +11,7 @@ import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (smpClientVRange)
+import Simplex.Messaging.Protocol (ProtocolServer (..), smpClientVRange)
 import Simplex.Messaging.Version
 import Test.Hspec
 
@@ -20,7 +20,7 @@ uri = "smp.simplex.im"
 
 srv :: SMPServer
 srv =
-  SMPServer
+  ProtocolServer
     { host = "smp.simplex.im",
       port = "5223",
       keyHash = C.KeyHash "\215m\248\251"
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index 2d7b82375..e232ffdbd 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -24,7 +24,7 @@ import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Server (runSMPAgentBlocking)
-import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig)
+import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultClientConfig)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.KeepAlive
@@ -162,7 +162,7 @@ cfg =
       tbqSize = 1,
       dbFile = testDB,
       smpCfg =
-        smpDefaultConfig
+        defaultClientConfig
           { qSize = 1,
             defaultTransport = (testPort, transport @TLS),
             tcpTimeout = 500_000

From fb26916eea4f7148d823b5c48fb7673433681ff1 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 3 Apr 2022 10:37:32 +0100
Subject: [PATCH 04/12] ntf-server CLI, re-use SMP server CLI as a library
 (#347)

* ntf-server CLI, re-use SMP server CLI as a library

* add executable name
---
 apps/ntf-server/Main.hs                       |  50 +++
 apps/smp-server/Main.hs                       | 343 ++----------------
 package.yaml                                  |  16 +-
 simplexmq.cabal                               |  59 +++
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |   7 +-
 src/Simplex/Messaging/Client.hs               |   2 +-
 .../Messaging/Notifications/Server/Env.hs     |   2 -
 src/Simplex/Messaging/Server/CLI.hs           | 285 +++++++++++++++
 src/Simplex/Messaging/Server/Env/STM.hs       |   8 +-
 tests/SMPClient.hs                            |   9 +-
 10 files changed, 458 insertions(+), 323 deletions(-)
 create mode 100644 apps/ntf-server/Main.hs
 create mode 100644 src/Simplex/Messaging/Server/CLI.hs

diff --git a/apps/ntf-server/Main.hs b/apps/ntf-server/Main.hs
new file mode 100644
index 000000000..8426093e5
--- /dev/null
+++ b/apps/ntf-server/Main.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Main where
+
+import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
+import Simplex.Messaging.Notifications.Server (runNtfServer)
+import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
+import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI)
+import System.FilePath (combine)
+
+cfgPath :: FilePath
+cfgPath = "/etc/opt/simplex-notifications"
+
+logPath :: FilePath
+logPath = "/var/opt/simplex-notifications"
+
+main :: IO ()
+main = protocolServerCLI ntfServerCLIConfig runNtfServer
+
+ntfServerCLIConfig :: ServerCLIConfig NtfServerConfig
+ntfServerCLIConfig =
+  let caCrtFile = combine cfgPath "ca.crt"
+      serverKeyFile = combine cfgPath "server.key"
+      serverCrtFile = combine cfgPath "server.crt"
+   in ServerCLIConfig
+        { cfgDir = cfgPath,
+          logDir = logPath,
+          iniFile = combine cfgPath "ntf-server.ini",
+          storeLogFile = combine logPath "ntf-server-store.log",
+          caKeyFile = combine cfgPath "ca.key",
+          caCrtFile,
+          serverKeyFile,
+          serverCrtFile,
+          fingerprintFile = combine cfgPath "fingerprint",
+          defaultServerPort = "443",
+          executableName = "ntf-server",
+          serverVersion = "SMP notifications server v0.1.0",
+          mkServerConfig = \_storeLogFile transports ->
+            NtfServerConfig
+              { transports,
+                subIdBytes = 24,
+                clientQSize = 16,
+                subQSize = 64,
+                pushQSize = 128,
+                smpAgentCfg = defaultSMPClientAgentConfig,
+                caCertificateFile = caCrtFile,
+                privateKeyFile = serverKeyFile,
+                certificateFile = serverCrtFile
+              }
+        }
diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs
index 163b312c8..28b6b754b 100644
--- a/apps/smp-server/Main.hs
+++ b/apps/smp-server/Main.hs
@@ -1,318 +1,53 @@
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Main where
 
-import Control.Monad.Except
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Data.Either (fromRight)
-import Data.Ini (Ini, lookupValue, readIniFile)
-import Data.Maybe (fromMaybe)
-import qualified Data.Text as T
-import Data.X509.Validation (Fingerprint (..))
-import Network.Socket (HostName, ServiceName)
-import Options.Applicative
-import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Server (runSMPServer)
-import Simplex.Messaging.Server.Env.STM
-import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
-import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..), simplexMQVersion)
-import Simplex.Messaging.Transport.Server (loadFingerprint)
-import Simplex.Messaging.Transport.WebSockets (WS)
-import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeDirectoryRecursive)
-import System.Exit (exitFailure)
+import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI)
+import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
+import Simplex.Messaging.Transport (simplexMQVersion)
 import System.FilePath (combine)
-import System.IO (BufferMode (..), IOMode (..), hGetLine, hSetBuffering, stderr, stdout, withFile)
-import System.Process (readCreateProcess, shell)
-import Text.Read (readMaybe)
 
-cfgDir :: FilePath
-cfgDir = "/etc/opt/simplex"
+cfgPath :: FilePath
+cfgPath = "/etc/opt/simplex"
 
-logDir :: FilePath
-logDir = "/var/opt/simplex"
-
-iniFile :: FilePath
-iniFile = combine cfgDir "smp-server.ini"
-
-storeLogFile :: FilePath
-storeLogFile = combine logDir "smp-server-store.log"
-
-caKeyFile :: FilePath
-caKeyFile = combine cfgDir "ca.key"
-
-caCrtFile :: FilePath
-caCrtFile = combine cfgDir "ca.crt"
-
-serverKeyFile :: FilePath
-serverKeyFile = combine cfgDir "server.key"
-
-serverCrtFile :: FilePath
-serverCrtFile = combine cfgDir "server.crt"
-
-fingerprintFile :: FilePath
-fingerprintFile = combine cfgDir "fingerprint"
+logPath :: FilePath
+logPath = "/var/opt/simplex"
 
 main :: IO ()
-main = do
-  getCliCommand >>= \case
-    Init opts ->
-      doesFileExist iniFile >>= \case
-        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `smp-server start`."
-        _ -> initializeServer opts
-    Start ->
-      doesFileExist iniFile >>= \case
-        True -> readIniFile iniFile >>= either exitError (runServer . mkIniOptions)
-        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `smp-server init`."
-    Delete -> cleanup >> putStrLn "Deleted configuration and log files"
+main = protocolServerCLI smpServerCLIConfig runSMPServer
 
-exitError :: String -> IO ()
-exitError msg = putStrLn msg >> exitFailure
-
-data CliCommand
-  = Init InitOptions
-  | Start
-  | Delete
-
-data InitOptions = InitOptions
-  { enableStoreLog :: Bool,
-    signAlgorithm :: SignAlgorithm,
-    ip :: HostName,
-    fqdn :: Maybe HostName
-  }
-  deriving (Show)
-
-data SignAlgorithm = ED448 | ED25519
-  deriving (Read, Show)
-
-getCliCommand :: IO CliCommand
-getCliCommand =
-  customExecParser
-    (prefs showHelpOnEmpty)
-    ( info
-        (helper <*> versionOption <*> cliCommandP)
-        (header version <> fullDesc)
-    )
-  where
-    versionOption = infoOption version (long "version" <> short 'v' <> help "Show version")
-
-cliCommandP :: Parser CliCommand
-cliCommandP =
-  hsubparser
-    ( command "init" (info initP (progDesc $ "Initialize server - creates " <> cfgDir <> " and " <> logDir <> " directories and configuration files"))
-        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
-        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
-    )
-  where
-    initP :: Parser CliCommand
-    initP =
-      Init
-        <$> ( InitOptions
-                <$> switch
-                  ( long "store-log"
-                      <> short 'l'
-                      <> help "Enable store log for SMP queues persistence"
-                  )
-                <*> option
-                  (maybeReader readMaybe)
-                  ( long "sign-algorithm"
-                      <> short 'a'
-                      <> help "Signature algorithm used for TLS certificates: ED25519, ED448"
-                      <> value ED448
-                      <> showDefault
-                      <> metavar "ALG"
-                  )
-                <*> strOption
-                  ( long "ip"
-                      <> help
-                        "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
-                      <> value "127.0.0.1"
-                      <> showDefault
-                      <> metavar "IP"
-                  )
-                <*> (optional . strOption)
-                  ( long "fqdn"
-                      <> short 'n'
-                      <> help "Server FQDN used as Common Name for TLS online certificate"
-                      <> showDefault
-                      <> metavar "FQDN"
-                  )
-            )
-
-initializeServer :: InitOptions -> IO ()
-initializeServer InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} = do
-  cleanup
-  createDirectoryIfMissing True cfgDir
-  createDirectoryIfMissing True logDir
-  createX509
-  fp <- saveFingerprint
-  createIni
-  putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `smp-server start` to start server."
-  printServiceInfo fp
-  warnCAPrivateKeyFile
-  where
-    createX509 = do
-      createOpensslCaConf
-      createOpensslServerConf
-      -- CA certificate (identity/offline)
-      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> caKeyFile
-      run $ "openssl req -new -x509 -days 999999 -config " <> opensslCaConfFile <> " -extensions v3 -key " <> caKeyFile <> " -out " <> caCrtFile
-      -- server certificate (online)
-      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> serverKeyFile
-      run $ "openssl req -new -config " <> opensslServerConfFile <> " -reqexts v3 -key " <> serverKeyFile <> " -out " <> serverCsrFile
-      run $ "openssl x509 -req -days 999999 -extfile " <> opensslServerConfFile <> " -extensions v3 -in " <> serverCsrFile <> " -CA " <> caCrtFile <> " -CAkey " <> caKeyFile <> " -CAcreateserial -out " <> serverCrtFile
-      where
-        run cmd = void $ readCreateProcess (shell cmd) ""
-        opensslCaConfFile = combine cfgDir "openssl_ca.conf"
-        opensslServerConfFile = combine cfgDir "openssl_server.conf"
-        serverCsrFile = combine cfgDir "server.csr"
-        createOpensslCaConf =
-          writeFile
-            opensslCaConfFile
-            "[req]\n\
-            \distinguished_name = req_distinguished_name\n\
-            \prompt = no\n\n\
-            \[req_distinguished_name]\n\
-            \CN = SMP server CA\n\
-            \O = SimpleX\n\n\
-            \[v3]\n\
-            \subjectKeyIdentifier = hash\n\
-            \authorityKeyIdentifier = keyid:always\n\
-            \basicConstraints = critical,CA:true\n"
-        -- TODO revise https://www.rfc-editor.org/rfc/rfc5280#section-4.2.1.3, https://www.rfc-editor.org/rfc/rfc3279#section-2.3.5
-        -- IP and FQDN can't both be used as server address interchangeably even if IP is added
-        -- as Subject Alternative Name, unless the following validation hook is disabled:
-        -- https://hackage.haskell.org/package/x509-validation-1.6.10/docs/src/Data-X509-Validation.html#validateCertificateName
-        createOpensslServerConf =
-          writeFile
-            opensslServerConfFile
-            ( "[req]\n\
-              \distinguished_name = req_distinguished_name\n\
-              \prompt = no\n\n\
-              \[req_distinguished_name]\n"
-                <> ("CN = " <> cn <> "\n\n")
-                <> "[v3]\n\
-                   \basicConstraints = CA:FALSE\n\
-                   \keyUsage = digitalSignature, nonRepudiation, keyAgreement\n\
-                   \extendedKeyUsage = serverAuth\n"
-            )
-          where
-            cn = fromMaybe ip fqdn
-
-    saveFingerprint = do
-      Fingerprint fp <- loadFingerprint caCrtFile
-      withFile fingerprintFile WriteMode (`B.hPutStrLn` strEncode fp)
-      pure fp
-
-    createIni = do
-      writeFile iniFile $
-        "[STORE_LOG]\n\
-        \# The server uses STM memory to store SMP queues and messages,\n\
-        \# that will be lost on restart (e.g., as with redis).\n\
-        \# This option enables saving SMP queues to append only log,\n\
-        \# and restoring them when the server is started.\n\
-        \# Log is compacted on start (deleted queues are removed).\n\
-        \# The messages in the queues are not logged.\n"
-          <> ("enable: " <> (if enableStoreLog then "on" else "off  # on") <> "\n\n")
-          <> "[TRANSPORT]\n\
-             \port: 5223\n\
-             \websockets: off\n"
-
-    warnCAPrivateKeyFile =
-      putStrLn $
-        "----------\n\
-        \You should store CA private key securely and delete it from the server.\n\
-        \If server TLS credential is compromised this key can be used to sign a new one, \
-        \keeping the same server identity and established connections.\n\
-        \CA private key location:\n"
-          <> caKeyFile
-          <> "\n----------"
-
-data IniOptions = IniOptions
-  { enableStoreLog :: Bool,
-    port :: ServiceName,
-    enableWebsockets :: Bool
-  }
-
--- TODO ? properly parse ini as a whole
-mkIniOptions :: Ini -> IniOptions
-mkIniOptions ini =
-  IniOptions
-    { enableStoreLog = (== "on") $ strict "STORE_LOG" "enable",
-      port = T.unpack $ strict "TRANSPORT" "port",
-      enableWebsockets = (== "on") $ strict "TRANSPORT" "websockets"
-    }
-  where
-    strict :: String -> String -> T.Text
-    strict section key =
-      fromRight (error ("no key " <> key <> " in section " <> section)) $
-        lookupValue (T.pack section) (T.pack key) ini
-
-runServer :: IniOptions -> IO ()
-runServer IniOptions {enableStoreLog, port, enableWebsockets} = do
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stderr LineBuffering
-  fp <- checkSavedFingerprint
-  printServiceInfo fp
-  storeLog <- openStoreLog
-  let cfg = mkServerConfig storeLog
-  printServerConfig cfg
-  runSMPServer cfg
-  where
-    checkSavedFingerprint = do
-      savedFingerprint <- loadSavedFingerprint
-      Fingerprint fp <- loadFingerprint caCrtFile
-      when (B.pack savedFingerprint /= strEncode fp) $
-        exitError "Stored fingerprint is invalid."
-      pure fp
-
-    mkServerConfig storeLog =
-      ServerConfig
-        { transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets],
-          tbqSize = 16,
-          serverTbqSize = 64,
-          msgQueueQuota = 128,
-          queueIdBytes = 24,
-          msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
-          caCertificateFile = caCrtFile,
-          privateKeyFile = serverKeyFile,
-          certificateFile = serverCrtFile,
-          storeLog
+smpServerCLIConfig :: ServerCLIConfig ServerConfig
+smpServerCLIConfig =
+  let caCrtFile = combine cfgPath "ca.crt"
+      serverKeyFile = combine cfgPath "server.key"
+      serverCrtFile = combine cfgPath "server.crt"
+   in ServerCLIConfig
+        { cfgDir = cfgPath,
+          logDir = logPath,
+          iniFile = combine cfgPath "smp-server.ini",
+          storeLogFile = combine logPath "smp-server-store.log",
+          caKeyFile = combine cfgPath "ca.key",
+          caCrtFile,
+          serverKeyFile,
+          serverCrtFile,
+          fingerprintFile = combine cfgPath "fingerprint",
+          defaultServerPort = "5223",
+          executableName = "smp-server",
+          serverVersion = "SMP server v" <> simplexMQVersion,
+          mkServerConfig = \storeLogFile transports ->
+            ServerConfig
+              { transports,
+                tbqSize = 16,
+                serverTbqSize = 64,
+                msgQueueQuota = 128,
+                queueIdBytes = 24,
+                msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
+                caCertificateFile = caCrtFile,
+                privateKeyFile = serverKeyFile,
+                certificateFile = serverCrtFile,
+                storeLogFile
+              }
         }
-
-    openStoreLog :: IO (Maybe (StoreLog 'ReadMode))
-    openStoreLog =
-      if enableStoreLog
-        then Just <$> openReadStoreLog storeLogFile
-        else pure Nothing
-
-    printServerConfig ServerConfig {storeLog, transports} = do
-      putStrLn $ case storeLog of
-        Just s -> "Store log: " <> storeLogFilePath s
-        Nothing -> "Store log disabled."
-      forM_ transports $ \(p, ATransport t) ->
-        putStrLn $ "Listening on port " <> p <> " (" <> transportName t <> ")..."
-
-cleanup :: IO ()
-cleanup = do
-  deleteDirIfExists cfgDir
-  deleteDirIfExists logDir
-  where
-    deleteDirIfExists path = doesDirectoryExist path >>= (`when` removeDirectoryRecursive path)
-
-printServiceInfo :: ByteString -> IO ()
-printServiceInfo fpStr = do
-  putStrLn version
-  B.putStrLn $ "Fingerprint: " <> strEncode fpStr
-
-version :: String
-version = "SMP server v" <> simplexMQVersion
-
-loadSavedFingerprint :: IO String
-loadSavedFingerprint = withFile fingerprintFile ReadMode hGetLine
diff --git a/package.yaml b/package.yaml
index f87ca111b..40d8e8955 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,7 +1,7 @@
 name: simplexmq
 version: 1.0.3
 synopsis: SimpleXMQ message broker
-description:  |
+description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
   <./docs/Simplex-Messaging-Client.html client> and
   <./docs/Simplex-Messaging-Agent.html agent> for SMP protocols:
@@ -42,12 +42,15 @@ dependencies:
   - filepath == 1.4.*
   - http-types == 0.12.*
   - generic-random >= 1.3 && < 1.5
+  - ini == 0.4.*
   - iso8601-time == 0.1.*
   - memory == 0.15.*
   - mtl == 2.2.*
   - network == 3.1.2.*
   - network-transport == 0.5.*
+  - optparse-applicative >= 0.15 && < 0.17
   - QuickCheck == 2.14.*
+  - process == 1.6.*
   - random >= 1.1 && < 1.3
   - simple-logger == 0.1.*
   - sqlite-simple == 0.4.*
@@ -72,9 +75,14 @@ executables:
     source-dirs: apps/smp-server
     main: Main.hs
     dependencies:
-      - ini == 0.4.*
-      - optparse-applicative >= 0.15 && < 0.17
-      - process == 1.6.*
+      - simplexmq
+    ghc-options:
+      - -threaded
+
+  ntf-server:
+    source-dirs: apps/ntf-server
+    main: Main.hs
+    dependencies:
       - simplexmq
     ghc-options:
       - -threaded
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 3b9e8eb7e..66089a3e3 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -57,6 +57,7 @@ library
       Simplex.Messaging.Parsers
       Simplex.Messaging.Protocol
       Simplex.Messaging.Server
+      Simplex.Messaging.Server.CLI
       Simplex.Messaging.Server.Env.STM
       Simplex.Messaging.Server.MsgStore
       Simplex.Messaging.Server.MsgStore.STM
@@ -98,11 +99,14 @@ library
     , filepath ==1.4.*
     , generic-random >=1.3 && <1.5
     , http-types ==0.12.*
+    , ini ==0.4.*
     , iso8601-time ==0.1.*
     , memory ==0.15.*
     , mtl ==2.2.*
     , network ==3.1.2.*
     , network-transport ==0.5.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
     , random >=1.1 && <1.3
     , simple-logger ==0.1.*
     , sqlite-simple ==0.4.*
@@ -227,6 +231,61 @@ executable smp-server
     , x509-validation ==1.6.*
   default-language: Haskell2010
 
+executable ntf-server
+  main-is: Main.hs
+  other-modules:
+      Paths_simplexmq
+  hs-source-dirs:
+      apps/ntf-server
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  build-depends:
+      QuickCheck ==2.14.*
+    , aeson ==2.0.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
+    , data-default ==0.7.*
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , http-types ==0.12.*
+    , ini ==0.4.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.2.*
+    , network-transport ==0.5.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , tls >=1.5.7 && <1.6
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
+  default-language: Haskell2010
+
 test-suite smp-server-test
   type: exitcode-stdio-1.0
   main-is: Test.hs
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 66f510ff6..af400ff81 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 module Simplex.Messaging.Agent.Env.SQLite
@@ -23,8 +24,8 @@ 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 Simplex.Messaging.Client.Agent (SMPClientAgentConfig, defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Transport (TLS, Transport (..))
 import System.Random (StdGen, newStdGen)
 import UnliftIO.STM
 
@@ -57,8 +58,8 @@ defaultAgentConfig =
       dbFile = "smp-agent.db",
       dbPoolSize = 4,
       yesToMigrations = False,
-      smpCfg = defaultClientConfig,
-      ntfCfg = defaultClientConfig,
+      smpCfg = defaultClientConfig {defaultTransport = ("5223", transport @TLS)},
+      ntfCfg = defaultClientConfig {defaultTransport = ("443", transport @TLS)},
       reconnectInterval =
         RetryInterval
           { initialInterval = second,
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index db30d3085..75ce01126 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -112,7 +112,7 @@ defaultClientConfig :: ProtocolClientConfig
 defaultClientConfig =
   ProtocolClientConfig
     { qSize = 64,
-      defaultTransport = ("5223", transport @TLS),
+      defaultTransport = ("443", transport @TLS),
       tcpTimeout = 5_000_000,
       tcpKeepAlive = Just defaultKeepAliveOpts,
       smpPing = 300_000_000 -- 5 min
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index fec2aafb6..8b2a416a1 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -13,7 +13,6 @@ import Data.X509.Validation (Fingerprint (..))
 import Network.Socket
 import qualified Network.TLS as T
 import Numeric.Natural
-import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
@@ -30,7 +29,6 @@ data NtfServerConfig = NtfServerConfig
     subQSize :: Natural,
     pushQSize :: Natural,
     smpAgentCfg :: SMPClientAgentConfig,
-    reconnectInterval :: RetryInterval,
     -- CA certificate private key is not needed for initialization
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs
new file mode 100644
index 000000000..63959d45a
--- /dev/null
+++ b/src/Simplex/Messaging/Server/CLI.hs
@@ -0,0 +1,285 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Simplex.Messaging.Server.CLI where
+
+import Control.Monad
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Either (fromRight)
+import Data.Ini (Ini, lookupValue, readIniFile)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Data.X509.Validation (Fingerprint (..))
+import Network.Socket (HostName, ServiceName)
+import Options.Applicative
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
+import Simplex.Messaging.Transport.Server (loadFingerprint)
+import Simplex.Messaging.Transport.WebSockets (WS)
+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeDirectoryRecursive)
+import System.Exit (exitFailure)
+import System.FilePath (combine)
+import System.IO (BufferMode (..), IOMode (..), hGetLine, hSetBuffering, stderr, stdout, withFile)
+import System.Process (readCreateProcess, shell)
+import Text.Read (readMaybe)
+
+data ServerCLIConfig cfg = ServerCLIConfig
+  { cfgDir :: FilePath,
+    logDir :: FilePath,
+    iniFile :: FilePath,
+    storeLogFile :: FilePath,
+    caKeyFile :: FilePath,
+    caCrtFile :: FilePath,
+    serverKeyFile :: FilePath,
+    serverCrtFile :: FilePath,
+    fingerprintFile :: FilePath,
+    defaultServerPort :: ServiceName,
+    executableName :: String,
+    serverVersion :: String,
+    mkServerConfig :: Maybe FilePath -> [(ServiceName, ATransport)] -> cfg
+  }
+
+protocolServerCLI :: ServerCLIConfig cfg -> (cfg -> IO ()) -> IO ()
+protocolServerCLI cliCfg@ServerCLIConfig {iniFile, executableName} server =
+  getCliCommand cliCfg >>= \case
+    Init opts ->
+      doesFileExist iniFile >>= \case
+        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`."
+        _ -> initializeServer cliCfg opts
+    Start ->
+      doesFileExist iniFile >>= \case
+        True -> readIniFile iniFile >>= either exitError (runServer cliCfg server . mkIniOptions)
+        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
+    Delete -> cleanup cliCfg >> putStrLn "Deleted configuration and log files"
+
+exitError :: String -> IO ()
+exitError msg = putStrLn msg >> exitFailure
+
+data CliCommand
+  = Init InitOptions
+  | Start
+  | Delete
+
+data InitOptions = InitOptions
+  { enableStoreLog :: Bool,
+    signAlgorithm :: SignAlgorithm,
+    ip :: HostName,
+    fqdn :: Maybe HostName
+  }
+  deriving (Show)
+
+data SignAlgorithm = ED448 | ED25519
+  deriving (Read, Show)
+
+getCliCommand :: ServerCLIConfig cfg -> IO CliCommand
+getCliCommand cliCfg =
+  customExecParser
+    (prefs showHelpOnEmpty)
+    ( info
+        (helper <*> versionOption <*> cliCommandP cliCfg)
+        (header version <> fullDesc)
+    )
+  where
+    versionOption = infoOption version (long "version" <> short 'v' <> help "Show version")
+    version = serverVersion cliCfg
+
+cliCommandP :: ServerCLIConfig cfg -> Parser CliCommand
+cliCommandP ServerCLIConfig {cfgDir, logDir, iniFile} =
+  hsubparser
+    ( command "init" (info initP (progDesc $ "Initialize server - creates " <> cfgDir <> " and " <> logDir <> " directories and configuration files"))
+        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
+        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
+    )
+  where
+    initP :: Parser CliCommand
+    initP =
+      Init
+        <$> ( InitOptions
+                <$> switch
+                  ( long "store-log"
+                      <> short 'l'
+                      <> help "Enable store log for persistence"
+                  )
+                <*> option
+                  (maybeReader readMaybe)
+                  ( long "sign-algorithm"
+                      <> short 'a'
+                      <> help "Signature algorithm used for TLS certificates: ED25519, ED448"
+                      <> value ED448
+                      <> showDefault
+                      <> metavar "ALG"
+                  )
+                <*> strOption
+                  ( long "ip"
+                      <> help
+                        "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
+                      <> value "127.0.0.1"
+                      <> showDefault
+                      <> metavar "IP"
+                  )
+                <*> (optional . strOption)
+                  ( long "fqdn"
+                      <> short 'n'
+                      <> help "Server FQDN used as Common Name for TLS online certificate"
+                      <> showDefault
+                      <> metavar "FQDN"
+                  )
+            )
+
+initializeServer :: ServerCLIConfig cfg -> InitOptions -> IO ()
+initializeServer cliCfg InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} = do
+  cleanup cliCfg
+  createDirectoryIfMissing True cfgDir
+  createDirectoryIfMissing True logDir
+  createX509
+  fp <- saveFingerprint
+  createIni
+  putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
+  printServiceInfo cliCfg fp
+  warnCAPrivateKeyFile
+  where
+    ServerCLIConfig {cfgDir, logDir, iniFile, executableName, caKeyFile, caCrtFile, serverKeyFile, serverCrtFile, fingerprintFile, defaultServerPort} = cliCfg
+    createX509 = do
+      createOpensslCaConf
+      createOpensslServerConf
+      -- CA certificate (identity/offline)
+      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> caKeyFile
+      run $ "openssl req -new -x509 -days 999999 -config " <> opensslCaConfFile <> " -extensions v3 -key " <> caKeyFile <> " -out " <> caCrtFile
+      -- server certificate (online)
+      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> serverKeyFile
+      run $ "openssl req -new -config " <> opensslServerConfFile <> " -reqexts v3 -key " <> serverKeyFile <> " -out " <> serverCsrFile
+      run $ "openssl x509 -req -days 999999 -extfile " <> opensslServerConfFile <> " -extensions v3 -in " <> serverCsrFile <> " -CA " <> caCrtFile <> " -CAkey " <> caKeyFile <> " -CAcreateserial -out " <> serverCrtFile
+      where
+        run cmd = void $ readCreateProcess (shell cmd) ""
+        opensslCaConfFile = combine cfgDir "openssl_ca.conf"
+        opensslServerConfFile = combine cfgDir "openssl_server.conf"
+        serverCsrFile = combine cfgDir "server.csr"
+        createOpensslCaConf =
+          writeFile
+            opensslCaConfFile
+            "[req]\n\
+            \distinguished_name = req_distinguished_name\n\
+            \prompt = no\n\n\
+            \[req_distinguished_name]\n\
+            \CN = SMP server CA\n\
+            \O = SimpleX\n\n\
+            \[v3]\n\
+            \subjectKeyIdentifier = hash\n\
+            \authorityKeyIdentifier = keyid:always\n\
+            \basicConstraints = critical,CA:true\n"
+        -- TODO revise https://www.rfc-editor.org/rfc/rfc5280#section-4.2.1.3, https://www.rfc-editor.org/rfc/rfc3279#section-2.3.5
+        -- IP and FQDN can't both be used as server address interchangeably even if IP is added
+        -- as Subject Alternative Name, unless the following validation hook is disabled:
+        -- https://hackage.haskell.org/package/x509-validation-1.6.10/docs/src/Data-X509-Validation.html#validateCertificateName
+        createOpensslServerConf =
+          writeFile
+            opensslServerConfFile
+            ( "[req]\n\
+              \distinguished_name = req_distinguished_name\n\
+              \prompt = no\n\n\
+              \[req_distinguished_name]\n"
+                <> ("CN = " <> cn <> "\n\n")
+                <> "[v3]\n\
+                   \basicConstraints = CA:FALSE\n\
+                   \keyUsage = digitalSignature, nonRepudiation, keyAgreement\n\
+                   \extendedKeyUsage = serverAuth\n"
+            )
+          where
+            cn = fromMaybe ip fqdn
+
+    saveFingerprint = do
+      Fingerprint fp <- loadFingerprint caCrtFile
+      withFile fingerprintFile WriteMode (`B.hPutStrLn` strEncode fp)
+      pure fp
+
+    createIni = do
+      writeFile iniFile $
+        "[STORE_LOG]\n\
+        \# The server uses STM memory for persistence,\n\
+        \# that will be lost on restart (e.g., as with redis).\n\
+        \# This option enables saving memory to append only log,\n\
+        \# and restoring it when the server is started.\n\
+        \# Log is compacted on start (deleted objects are removed).\n\
+        \# The messages are not logged.\n"
+          <> ("enable: " <> (if enableStoreLog then "on" else "off  # on") <> "\n\n")
+          <> "[TRANSPORT]\n\
+             \port: "
+          <> defaultServerPort
+          <> "\n\
+             \websockets: off\n"
+
+    warnCAPrivateKeyFile =
+      putStrLn $
+        "----------\n\
+        \You should store CA private key securely and delete it from the server.\n\
+        \If server TLS credential is compromised this key can be used to sign a new one, \
+        \keeping the same server identity and established connections.\n\
+        \CA private key location:\n"
+          <> caKeyFile
+          <> "\n----------"
+
+data IniOptions = IniOptions
+  { enableStoreLog :: Bool,
+    port :: ServiceName,
+    enableWebsockets :: Bool
+  }
+
+-- TODO ? properly parse ini as a whole
+mkIniOptions :: Ini -> IniOptions
+mkIniOptions ini =
+  IniOptions
+    { enableStoreLog = (== "on") $ strict "STORE_LOG" "enable",
+      port = T.unpack $ strict "TRANSPORT" "port",
+      enableWebsockets = (== "on") $ strict "TRANSPORT" "websockets"
+    }
+  where
+    strict :: String -> String -> T.Text
+    strict section key =
+      fromRight (error ("no key " <> key <> " in section " <> section)) $
+        lookupValue (T.pack section) (T.pack key) ini
+
+runServer :: ServerCLIConfig cfg -> (cfg -> IO ()) -> IniOptions -> IO ()
+runServer cliCfg server IniOptions {enableStoreLog, port, enableWebsockets} = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
+  fp <- checkSavedFingerprint
+  printServiceInfo cliCfg fp
+  let transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets]
+      logFile = if enableStoreLog then Just storeLogFile else Nothing
+      cfg = mkServerConfig logFile transports
+  printServerConfig logFile transports
+  server cfg
+  where
+    ServerCLIConfig {storeLogFile, caCrtFile, fingerprintFile, mkServerConfig} = cliCfg
+    checkSavedFingerprint = do
+      savedFingerprint <- withFile fingerprintFile ReadMode hGetLine
+      Fingerprint fp <- loadFingerprint caCrtFile
+      when (B.pack savedFingerprint /= strEncode fp) $
+        exitError "Stored fingerprint is invalid."
+      pure fp
+
+    printServerConfig logFile transports = do
+      putStrLn $ case logFile of
+        Just f -> "Store log: " <> f
+        _ -> "Store log disabled."
+      forM_ transports $ \(p, ATransport t) ->
+        putStrLn $ "Listening on port " <> p <> " (" <> transportName t <> ")..."
+
+cleanup :: ServerCLIConfig cfg -> IO ()
+cleanup ServerCLIConfig {cfgDir, logDir} = do
+  deleteDirIfExists cfgDir
+  deleteDirIfExists logDir
+  where
+    deleteDirIfExists path = doesDirectoryExist path >>= (`when` removeDirectoryRecursive path)
+
+printServiceInfo :: ServerCLIConfig cfg -> ByteString -> IO ()
+printServiceInfo ServerCLIConfig {serverVersion} fpStr = do
+  putStrLn serverVersion
+  B.putStrLn $ "Fingerprint: " <> strEncode fpStr
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 3c4599a97..f704367a6 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -35,7 +35,8 @@ data ServerConfig = ServerConfig
     msgQueueQuota :: Natural,
     queueIdBytes :: Int,
     msgIdBytes :: Int,
-    storeLog :: Maybe (StoreLog 'ReadMode),
+    storeLogFile :: Maybe FilePath,
+    -- storeLog :: Maybe (StoreLog 'ReadMode),
     -- CA certificate private key is not needed for initialization
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
@@ -99,12 +100,13 @@ newSubscription = do
   return Sub {subThread = NoSub, delivered}
 
 newEnv :: forall m. (MonadUnliftIO m, MonadRandom m) => ServerConfig -> m Env
-newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile} = do
+newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile} = do
   server <- atomically $ newServer (serverTbqSize config)
   queueStore <- atomically newQueueStore
   msgStore <- atomically newMsgStore
   idsDrg <- drgNew >>= newTVarIO
-  s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
+  storeLog <- liftIO $ openReadStoreLog `mapM` storeLogFile
+  s' <- restoreQueues queueStore `mapM` storeLog
   tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
   Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
   let serverIdentity = KeyHash fp
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 3789647f5..e5a57ab72 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -19,7 +19,6 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
-import Simplex.Messaging.Server.StoreLog (openReadStoreLog)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.KeepAlive
@@ -60,19 +59,17 @@ cfg =
       msgQueueQuota = 4,
       queueIdBytes = 24,
       msgIdBytes = 24,
-      storeLog = Nothing,
+      storeLogFile = Nothing,
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
       certificateFile = "tests/fixtures/server.crt"
     }
 
 withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerStoreLogOn t port' client = do
-  s <- liftIO $ openReadStoreLog testStoreLogFile
+withSmpServerStoreLogOn t port' =
   serverBracket
-    (\started -> runSMPServerBlocking started cfg {transports = [(port', t)], storeLog = Just s})
+    (\started -> runSMPServerBlocking started cfg {transports = [(port', t)], storeLogFile = Just testStoreLogFile})
     (pure ())
-    client
 
 withSmpServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
 withSmpServerThreadOn t port' =

From f577fcdacf15cac9f763555e4d97f6b5dd542bcf Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Fri, 8 Apr 2022 08:47:04 +0100
Subject: [PATCH 05/12] agent schema/methods/types/store methods for
 notifications tokens (#348)

* agent schema/methods/types/store methods for notifications tokens

* register notification token on the server

* agent commands for notification tokens

* refactor initial servers from AgentConfig

* agent store functions for notification tokens

* server STM store methods for tokens

* fix protocol client for ntfs (use generic handshake), minimal server and agent tests

* server command to verify ntf token
---
 apps/ntf-server/Main.hs                       |   1 +
 apps/smp-agent/Main.hs                        |  11 +-
 simplexmq.cabal                               |   2 +
 src/Simplex/Messaging/Agent.hs                | 117 ++++++++++++++++--
 src/Simplex/Messaging/Agent/Client.hs         |  44 +++++--
 src/Simplex/Messaging/Agent/Env/SQLite.hs     |  29 +++--
 src/Simplex/Messaging/Agent/Server.hs         |  12 +-
 src/Simplex/Messaging/Agent/Store.hs          |   8 ++
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  89 +++++++++++--
 .../Migrations/M20220322_notifications.hs     |  37 ++----
 .../M20220404_ntf_subscriptions_draft.hs      |  38 ++++++
 src/Simplex/Messaging/Client.hs               |  10 +-
 src/Simplex/Messaging/Encoding/String.hs      |   8 +-
 src/Simplex/Messaging/Notifications/Client.hs |  93 +++++++++++---
 .../Messaging/Notifications/Protocol.hs       |  87 +++++++++++--
 src/Simplex/Messaging/Notifications/Server.hs |  35 ++++--
 .../Messaging/Notifications/Server/Env.hs     |  18 ++-
 .../Notifications/Server/Subscriptions.hs     |  17 +--
 src/Simplex/Messaging/Parsers.hs              |  10 ++
 src/Simplex/Messaging/Protocol.hs             |   6 +-
 tests/AgentTests/FunctionalAPITests.hs        |  44 ++++---
 tests/NtfClient.hs                            | 106 ++++++++++++++++
 tests/NtfServerTests.hs                       |  40 ++++++
 tests/SMPAgentClient.hs                       |  15 ++-
 tests/Test.hs                                 |   2 +
 25 files changed, 732 insertions(+), 147 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs
 create mode 100644 tests/NtfClient.hs
 create mode 100644 tests/NtfServerTests.hs

diff --git a/apps/ntf-server/Main.hs b/apps/ntf-server/Main.hs
index 8426093e5..928b9e514 100644
--- a/apps/ntf-server/Main.hs
+++ b/apps/ntf-server/Main.hs
@@ -39,6 +39,7 @@ ntfServerCLIConfig =
             NtfServerConfig
               { transports,
                 subIdBytes = 24,
+                regCodeBytes = 32,
                 clientQSize = 16,
                 subQSize = 64,
                 pushQSize = 128,
diff --git a/apps/smp-agent/Main.hs b/apps/smp-agent/Main.hs
index 32e038f56..72ca7f073 100644
--- a/apps/smp-agent/Main.hs
+++ b/apps/smp-agent/Main.hs
@@ -11,7 +11,14 @@ import Simplex.Messaging.Agent.Server (runSMPAgent)
 import Simplex.Messaging.Transport (TLS, Transport (..))
 
 cfg :: AgentConfig
-cfg = defaultAgentConfig {initialSMPServers = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"]}
+cfg = defaultAgentConfig
+
+servers :: InitialAgentServers
+servers =
+  InitialAgentServers
+    { smp = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"],
+      ntf = []
+    }
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
@@ -20,4 +27,4 @@ main :: IO ()
 main = do
   putStrLn $ "SMP agent listening on port " ++ tcpPort (cfg :: AgentConfig)
   setLogLevel LogInfo -- LogError
-  withGlobalLogging logCfg $ runSMPAgent (transport @TLS) cfg
+  withGlobalLogging logCfg $ runSMPAgent (transport @TLS) cfg servers
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 66089a3e3..6bd072f5b 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -298,6 +298,8 @@ test-suite smp-server-test
       CoreTests.EncodingTests
       CoreTests.ProtocolErrorTests
       CoreTests.VersionRangeTests
+      NtfClient,
+      NtfServerTests
       ServerTests
       SMPAgentClient
       SMPClient
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 821f5fe5a..812fb6e72 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -48,6 +48,11 @@ module Simplex.Messaging.Agent
     suspendConnection,
     deleteConnection,
     setSMPServers,
+    setNtfServers,
+    registerNtfToken,
+    verifyNtfToken,
+    enableNtfCron,
+    deleteNtfToken,
     logConnection,
   )
 where
@@ -69,6 +74,7 @@ import Data.Maybe (isJust)
 import qualified Data.Text as T
 import Data.Time.Clock
 import Data.Time.Clock.System (systemToUTCTime)
+import Data.Word (Word16)
 import Database.SQLite.Simple (SQLError)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
@@ -80,7 +86,8 @@ import Simplex.Messaging.Client (ServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Notifications.Protocol (DeviceToken)
+import Simplex.Messaging.Notifications.Client
+import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode, NtfTknStatus (..))
 import Simplex.Messaging.Parsers (parse)
 import Simplex.Messaging.Protocol (BrokerMsg, MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
@@ -93,11 +100,11 @@ import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
 -- | Creates an SMP agent client instance
-getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> m AgentClient
-getSMPAgentClient cfg = newSMPAgentEnv cfg >>= runReaderT runAgent
+getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> InitialAgentServers -> m AgentClient
+getSMPAgentClient cfg initServers = newSMPAgentEnv cfg >>= runReaderT runAgent
   where
     runAgent = do
-      c <- getAgentClient
+      c <- getAgentClient initServers
       action <- async $ subscriber c `E.finally` disconnectAgentClient c
       pure c {smpSubscriber = action}
 
@@ -150,10 +157,24 @@ deleteConnection c = withAgentEnv c . deleteConnection' c
 setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServer -> m ()
 setSMPServers c = withAgentEnv c . setSMPServers' c
 
+setNtfServers :: AgentErrorMonad m => AgentClient -> [NtfServer] -> m ()
+setNtfServers c = withAgentEnv c . setNtfServers' c
+
 -- | Register device notifications token
 registerNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> m ()
 registerNtfToken c = withAgentEnv c . registerNtfToken' c
 
+-- | Verify device notifications token
+verifyNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> NtfRegCode -> m ()
+verifyNtfToken c = withAgentEnv c .: verifyNtfToken' c
+
+-- | Enable/disable periodic notifications
+enableNtfCron :: AgentErrorMonad m => AgentClient -> DeviceToken -> Word16 -> m ()
+enableNtfCron c = withAgentEnv c .: enableNtfCron' c
+
+deleteNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> m ()
+deleteNtfToken c = withAgentEnv c . deleteNtfToken' c
+
 withAgentEnv :: AgentClient -> ReaderT Env m a -> m a
 withAgentEnv c = (`runReaderT` agentEnv c)
 
@@ -161,8 +182,8 @@ withAgentEnv c = (`runReaderT` agentEnv c)
 -- withAgentClient c = withAgentLock c . withAgentEnv c
 
 -- | Creates an SMP agent client instance that receives commands and sends responses via 'TBQueue's.
-getAgentClient :: (MonadUnliftIO m, MonadReader Env m) => m AgentClient
-getAgentClient = ask >>= atomically . newAgentClient
+getAgentClient :: (MonadUnliftIO m, MonadReader Env m) => InitialAgentServers -> m AgentClient
+getAgentClient initServers = ask >>= atomically . newAgentClient initServers
 
 logConnection :: MonadUnliftIO m => AgentClient -> Bool -> m ()
 logConnection c connected =
@@ -499,8 +520,73 @@ setSMPServers' :: AgentMonad m => AgentClient -> NonEmpty SMPServer -> m ()
 setSMPServers' c servers = do
   atomically $ writeTVar (smpServers c) servers
 
-registerNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> m ()
-registerNtfToken' c token = pure ()
+registerNtfToken' :: forall m. AgentMonad m => AgentClient -> DeviceToken -> m ()
+registerNtfToken' c deviceToken =
+  withStore (`getDeviceNtfToken` deviceToken) >>= \case
+    Just tkn@NtfToken {ntfTokenId, ntfTknAction} -> case (ntfTokenId, ntfTknAction) of
+      (Nothing, Just (NTARegister ntfPubKey)) -> registerToken tkn ntfPubKey
+      -- TODO request verification code again in case there is registration, but no verification code in DB - probably after some timeout?
+      (Just tknId, Just (NTAVerify code)) ->
+        t tkn (NTActive, Just NTACheck) $ agentNtfVerifyToken c tknId tkn code
+      (Just tknId, Just (NTACron interval)) ->
+        t tkn (NTActive, Just NTACheck) $ agentNtfEnableCron c tknId tkn interval
+      (Just _tknId, Just NTACheck) -> pure ()
+      (Just tknId, Just NTADelete) ->
+        t tkn (NTExpired, Nothing) $ agentNtfDeleteToken c tknId tkn
+      _ -> pure ()
+    _ ->
+      getNtfServer c >>= \case
+        Just ntfServer ->
+          asks (cmdSignAlg . config) >>= \case
+            C.SignAlg a -> do
+              (ntfPubKey, ntfPrivKey) <- liftIO $ C.generateSignatureKeyPair a
+              let tkn = newNtfToken deviceToken ntfServer ntfPrivKey ntfPubKey
+              withStore $ \st -> createNtfToken st tkn
+              registerToken tkn ntfPubKey
+        _ -> throwError $ CMD PROHIBITED
+  where
+    t tkn = withToken tkn Nothing
+    registerToken :: NtfToken -> C.APublicVerifyKey -> m ()
+    registerToken tkn ntfPubKey = do
+      (pubDhKey, privDhKey) <- liftIO C.generateKeyPair'
+      (tknId, srvPubDhKey) <- agentNtfRegisterToken c tkn ntfPubKey pubDhKey
+      let dhSecret = C.dh' srvPubDhKey privDhKey
+      withStore $ \st -> updateNtfTokenRegistration st tkn tknId dhSecret
+
+verifyNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> NtfRegCode -> m ()
+verifyNtfToken' c deviceToken code =
+  withStore (`getDeviceNtfToken` deviceToken) >>= \case
+    Just tkn@NtfToken {ntfTokenId = Just tknId} ->
+      withToken tkn (Just (NTConfirmed, NTAVerify code)) (NTActive, Just NTACheck) $
+        agentNtfVerifyToken c tknId tkn code
+    _ -> throwError $ CMD PROHIBITED
+
+enableNtfCron' :: AgentMonad m => AgentClient -> DeviceToken -> Word16 -> m ()
+enableNtfCron' c deviceToken interval =
+  withStore (`getDeviceNtfToken` deviceToken) >>= \case
+    Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus = NTActive} ->
+      withToken tkn (Just (NTActive, NTACron interval)) (NTActive, Just NTACheck) $
+        agentNtfEnableCron c tknId tkn interval
+    _ -> throwError $ CMD PROHIBITED
+
+deleteNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> m ()
+deleteNtfToken' c deviceToken =
+  withStore (`getDeviceNtfToken` deviceToken) >>= \case
+    Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus} ->
+      withToken tkn (Just (ntfTknStatus, NTADelete)) (NTExpired, Nothing) $
+        agentNtfDeleteToken c tknId tkn
+    _ -> throwError $ CMD PROHIBITED
+
+withToken :: AgentMonad m => NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> m a -> m a
+withToken tkn from_ (toStatus, toAction_) f = do
+  forM_ from_ $ \(status, action) -> withStore $ \st -> updateNtfToken st tkn status (Just action)
+  res <- f
+  withStore $ \st -> updateNtfToken st tkn toStatus toAction_
+  pure res
+
+setNtfServers' :: AgentMonad m => AgentClient -> [NtfServer] -> m ()
+setNtfServers' c servers = do
+  atomically $ writeTVar (ntfServers c) servers
 
 getSMPServer :: AgentMonad m => AgentClient -> m SMPServer
 getSMPServer c = do
@@ -509,8 +595,19 @@ getSMPServer c = do
     srv :| [] -> pure srv
     servers -> do
       gen <- asks randomServer
-      i <- atomically . stateTVar gen $ randomR (0, L.length servers - 1)
-      pure $ servers L.!! i
+      atomically . stateTVar gen $
+        first (servers L.!!) . randomR (0, L.length servers - 1)
+
+getNtfServer :: AgentMonad m => AgentClient -> m (Maybe NtfServer)
+getNtfServer c = do
+  ntfServers <- readTVarIO $ ntfServers c
+  case ntfServers of
+    [] -> pure Nothing
+    [srv] -> pure $ Just srv
+    servers -> do
+      gen <- asks randomServer
+      atomically . stateTVar gen $
+        first (Just . (servers !!)) . randomR (0, length servers - 1)
 
 subscriber :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> m ()
 subscriber c@AgentClient {msgQ} = forever $ do
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 321fc82ab..fc37334db 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -8,7 +8,6 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 
 module Simplex.Messaging.Agent.Client
   ( AgentClient (..),
@@ -24,6 +23,10 @@ module Simplex.Messaging.Agent.Client
     RetryInterval (..),
     secureQueue,
     sendAgentMessage,
+    agentNtfRegisterToken,
+    agentNtfVerifyToken,
+    agentNtfDeleteToken,
+    agentNtfEnableCron,
     agentCbEncrypt,
     agentCbDecrypt,
     cryptoError,
@@ -51,6 +54,7 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (isNothing)
 import Data.Text.Encoding
+import Data.Word (Word16)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
@@ -59,8 +63,8 @@ import Simplex.Messaging.Client
 import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Notifications.Client (NtfClient)
-import Simplex.Messaging.Notifications.Protocol (NtfResponse)
+import Simplex.Messaging.Notifications.Client
+import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
@@ -83,8 +87,9 @@ data AgentClient = AgentClient
     subQ :: TBQueue (ATransmission 'Agent),
     msgQ :: TBQueue (ServerTransmission BrokerMsg),
     smpServers :: TVar (NonEmpty SMPServer),
+    ntfServers :: TVar [NtfServer],
     smpClients :: TMap SMPServer SMPClientVar,
-    ntfClients :: TMap ProtocolServer NtfClientVar,
+    ntfClients :: TMap NtfServer NtfClientVar,
     subscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue),
     pendingSubscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue),
     subscrConns :: TMap ConnId SMPServer,
@@ -99,13 +104,14 @@ data AgentClient = AgentClient
     lock :: TMVar ()
   }
 
-newAgentClient :: Env -> STM AgentClient
-newAgentClient agentEnv = do
+newAgentClient :: InitialAgentServers -> Env -> STM AgentClient
+newAgentClient InitialAgentServers {smp, ntf} agentEnv = do
   let qSize = tbqSize $ config agentEnv
   rcvQ <- newTBQueue qSize
   subQ <- newTBQueue qSize
   msgQ <- newTBQueue qSize
-  smpServers <- newTVar $ initialSMPServers (config agentEnv)
+  smpServers <- newTVar smp
+  ntfServers <- newTVar ntf
   smpClients <- TM.empty
   ntfClients <- TM.empty
   subscrSrvrs <- TM.empty
@@ -118,7 +124,7 @@ newAgentClient agentEnv = do
   asyncClients <- newTVar []
   clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
   lock <- newTMVar ()
-  return AgentClient {rcvQ, subQ, msgQ, smpServers, smpClients, ntfClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, asyncClients, clientId, agentEnv, smpSubscriber = undefined, lock}
+  return AgentClient {rcvQ, subQ, msgQ, smpServers, ntfServers, smpClients, ntfClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, asyncClients, clientId, agentEnv, smpSubscriber = undefined, lock}
 
 -- | Agent monad with MonadReader Env and MonadError AgentErrorType
 type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)
@@ -206,7 +212,7 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
     notifySub :: ACommand 'Agent -> ConnId -> IO ()
     notifySub cmd connId = atomically $ writeTBQueue (subQ c) ("", connId, cmd)
 
-getNtfServerClient :: forall m. AgentMonad m => AgentClient -> ProtocolServer -> m NtfClient
+getNtfServerClient :: forall m. AgentMonad m => AgentClient -> NtfServer -> m NtfClient
 getNtfServerClient c@AgentClient {ntfClients} srv =
   atomically (getClientVar srv ntfClients)
     >>= either
@@ -256,10 +262,10 @@ newProtocolClient c srv clients connectClient reconnectClient clientVar = tryCon
     tryConnectClient :: (ProtocolClient msg -> m a) -> m () -> m a
     tryConnectClient successAction retryAction =
       tryError connectClient >>= \r -> case r of
-        Right smp -> do
+        Right client -> do
           logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
           atomically $ putTMVar clientVar r
-          successAction smp
+          successAction client
         Left e -> do
           if e == BROKER NETWORK || e == BROKER TIMEOUT
             then retryAction
@@ -464,6 +470,22 @@ sendAgentMessage c sq@SndQueue {server, sndId, sndPrivateKey} agentMsg =
     msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
     liftClient $ sendSMPMessage smp (Just sndPrivateKey) sndId msg
 
+agentNtfRegisterToken :: AgentMonad m => AgentClient -> NtfToken -> C.APublicVerifyKey -> C.PublicKeyX25519 -> m (NtfTokenId, C.PublicKeyX25519)
+agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
+  withClient c ntfServer $ \ntf -> ntfRegisterToken ntf ntfPrivKey (NewNtfTkn deviceToken ntfPubKey pubDhKey)
+
+agentNtfVerifyToken :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> NtfRegCode -> m ()
+agentNtfVerifyToken c tknId NtfToken {ntfServer, ntfPrivKey} code =
+  withLogClient c ntfServer tknId "TVFY" $ \ntf -> ntfVerifyToken ntf ntfPrivKey tknId code
+
+agentNtfDeleteToken :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> m ()
+agentNtfDeleteToken c tknId NtfToken {ntfServer, ntfPrivKey} =
+  withLogClient c ntfServer tknId "TDEL" $ \ntf -> ntfDeleteToken ntf ntfPrivKey tknId
+
+agentNtfEnableCron :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> Word16 -> m ()
+agentNtfEnableCron c tknId NtfToken {ntfServer, ntfPrivKey} interval =
+  withLogClient c ntfServer tknId "TCRN" $ \ntf -> ntfEnableCron ntf ntfPrivKey tknId interval
+
 agentCbEncrypt :: AgentMonad m => SndQueue -> Maybe C.PublicKeyX25519 -> ByteString -> m ByteString
 agentCbEncrypt SndQueue {e2eDhSecret} e2ePubKey msg = do
   cmNonce <- liftIO C.randomCbNonce
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index af400ff81..bd1207426 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -7,7 +7,9 @@
 
 module Simplex.Messaging.Agent.Env.SQLite
   ( AgentConfig (..),
+    InitialAgentServers (..),
     defaultAgentConfig,
+    defaultReconnectInterval,
     Env (..),
     newSMPAgentEnv,
   )
@@ -25,13 +27,18 @@ 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 Simplex.Messaging.Notifications.Client (NtfServer)
 import Simplex.Messaging.Transport (TLS, Transport (..))
 import System.Random (StdGen, newStdGen)
 import UnliftIO.STM
 
+data InitialAgentServers = InitialAgentServers
+  { smp :: NonEmpty SMPServer,
+    ntf :: [NtfServer]
+  }
+
 data AgentConfig = AgentConfig
   { tcpPort :: ServiceName,
-    initialSMPServers :: NonEmpty SMPServer,
     cmdSignAlg :: C.SignAlg,
     connIdBytes :: Int,
     tbqSize :: Natural,
@@ -47,11 +54,20 @@ data AgentConfig = AgentConfig
     certificateFile :: FilePath
   }
 
+defaultReconnectInterval :: RetryInterval
+defaultReconnectInterval =
+  RetryInterval
+    { initialInterval = second,
+      increaseAfter = 10 * second,
+      maxInterval = 10 * second
+    }
+  where
+    second = 1_000_000
+
 defaultAgentConfig :: AgentConfig
 defaultAgentConfig =
   AgentConfig
     { tcpPort = "5224",
-      initialSMPServers = undefined, -- TODO move it elsewhere?
       cmdSignAlg = C.SignAlg C.SEd448,
       connIdBytes = 12,
       tbqSize = 64,
@@ -60,12 +76,7 @@ defaultAgentConfig =
       yesToMigrations = False,
       smpCfg = defaultClientConfig {defaultTransport = ("5223", transport @TLS)},
       ntfCfg = defaultClientConfig {defaultTransport = ("443", transport @TLS)},
-      reconnectInterval =
-        RetryInterval
-          { initialInterval = second,
-            increaseAfter = 10 * second,
-            maxInterval = 10 * second
-          },
+      reconnectInterval = defaultReconnectInterval,
       helloTimeout = 2 * nominalDay,
       -- CA certificate private key is not needed for initialization
       -- ! we do not generate these
@@ -73,8 +84,6 @@ defaultAgentConfig =
       privateKeyFile = "/etc/opt/simplex-agent/agent.key",
       certificateFile = "/etc/opt/simplex-agent/agent.crt"
     }
-  where
-    second = 1_000_000
 
 data Env = Env
   { config :: AgentConfig,
diff --git a/src/Simplex/Messaging/Agent/Server.hs b/src/Simplex/Messaging/Agent/Server.hs
index b3c70c9ac..7193cd772 100644
--- a/src/Simplex/Messaging/Agent/Server.hs
+++ b/src/Simplex/Messaging/Agent/Server.hs
@@ -31,17 +31,17 @@ import UnliftIO.STM
 -- | Runs an SMP agent as a TCP service using passed configuration.
 --
 -- See a full agent executable here: https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-agent/Main.hs
-runSMPAgent :: (MonadRandom m, MonadUnliftIO m) => ATransport -> AgentConfig -> m ()
-runSMPAgent t cfg = do
+runSMPAgent :: (MonadRandom m, MonadUnliftIO m) => ATransport -> AgentConfig -> InitialAgentServers -> m ()
+runSMPAgent t cfg initServers = do
   started <- newEmptyTMVarIO
-  runSMPAgentBlocking t started cfg
+  runSMPAgentBlocking t started cfg initServers
 
 -- | Runs an SMP agent as a TCP service using passed configuration with signalling.
 --
 -- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
 -- and when it is disconnected from the TCP socket once the server thread is killed (False).
-runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => ATransport -> TMVar Bool -> AgentConfig -> m ()
-runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertificateFile, certificateFile, privateKeyFile} = do
+runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => ATransport -> TMVar Bool -> AgentConfig -> InitialAgentServers -> m ()
+runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertificateFile, certificateFile, privateKeyFile} initServers = do
   runReaderT (smpAgent t) =<< newSMPAgentEnv cfg
   where
     smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
@@ -50,7 +50,7 @@ runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertifica
       tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
       runTransportServer started tcpPort tlsServerParams $ \(h :: c) -> do
         liftIO . putLn h $ "Welcome to SMP agent v" <> B.pack simplexMQVersion
-        c <- getAgentClient
+        c <- getAgentClient initServers
         logConnection c True
         race_ (connectClient h c) (runAgentClient c)
           `E.finally` disconnectAgentClient c
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index 4e20594a8..efcd87d3c 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -20,6 +20,8 @@ import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff, SkippedMsgKeys)
+import Simplex.Messaging.Notifications.Client
+import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfTknStatus, NtfTokenId)
 import Simplex.Messaging.Protocol
   ( MsgBody,
     MsgId,
@@ -75,6 +77,12 @@ class Monad m => MonadAgentStore s m where
   getSkippedMsgKeys :: s -> ConnId -> m SkippedMsgKeys
   updateRatchet :: s -> ConnId -> RatchetX448 -> SkippedMsgDiff -> m ()
 
+  -- Notification device token persistence
+  createNtfToken :: s -> NtfToken -> m ()
+  getDeviceNtfToken :: s -> DeviceToken -> m (Maybe NtfToken) -- return current token if it exists and mark any old tokens for deletion
+  updateNtfTokenRegistration :: s -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> m ()
+  updateNtfToken :: s -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> m ()
+
 -- * Queue types
 
 -- | A receive queue. SMP queue through which the agent receives messages from a sender.
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 3f42fd139..52235f852 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -23,7 +23,6 @@ module Simplex.Messaging.Agent.Store.SQLite
     connectSQLiteStore,
     withConnection,
     withTransaction,
-    fromTextField_,
     firstRow,
   )
 where
@@ -41,14 +40,14 @@ import Data.Char (toLower)
 import Data.Functor (($>))
 import Data.List (find, foldl')
 import qualified Data.Map.Strict as M
+import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
-import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, ToRow, field)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLError, ToRow, field)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.FromField
-import Database.SQLite.Simple.Internal (Field (..))
-import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.QQ (sql)
 import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.Protocol
@@ -59,7 +58,9 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (blobFieldParser)
+import Simplex.Messaging.Notifications.Client (NtfServer, NtfTknAction, NtfToken (..))
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus (..), NtfTokenId)
+import Simplex.Messaging.Parsers (blobFieldParser, fromTextField_)
 import Simplex.Messaging.Protocol (MsgBody, ProtocolServer (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Util (bshow, liftIOEither)
@@ -565,6 +566,63 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
             forM_ (M.assocs mks) $ \(msgN, mk) ->
               DB.execute db "INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)" (connId, hk, msgN, mk)
 
+  createNtfToken :: SQLiteStore -> NtfToken -> m ()
+  createNtfToken st NtfToken {deviceToken = DeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction} =
+    liftIO . withTransaction st $ \db -> do
+      upsertNtfServer_ db srv
+      DB.execute
+        db
+        [sql|
+          INSERT INTO ntf_tokens
+            (provider, device_token, ntf_host, ntf_port, tkn_id, tkn_priv_key, tkn_dh_secret, tkn_status, tkn_action) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)
+        |]
+        (provider, token, host, port, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction)
+
+  getDeviceNtfToken :: SQLiteStore -> DeviceToken -> m (Maybe NtfToken)
+  getDeviceNtfToken st t@(DeviceToken provider token) =
+    liftIO . withTransaction st $ \db ->
+      fmap ntfToken . listToMaybe
+        <$> DB.query
+          db
+          [sql|
+            SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
+              t.tkn_id, t.tkn_priv_key, t.tkn_dh_secret, t.tkn_status, t.tkn_action
+            FROM ntf_tokens t
+            JOIN ntf_servers s USING (ntf_host, ntf_port)
+            WHERE t.provider = ? AND t.device_token = ?
+          |]
+          (provider, token)
+    where
+      ntfToken (host, port, keyHash, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction) =
+        let ntfServer = ProtocolServer {host, port, keyHash}
+         in NtfToken {deviceToken = t, ntfServer, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction}
+
+  updateNtfTokenRegistration :: SQLiteStore -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> m ()
+  updateNtfTokenRegistration st NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret =
+    liftIO . withTransaction st $ \db -> do
+      updatedAt <- getCurrentTime
+      DB.execute
+        db
+        [sql|
+          UPDATE ntf_tokens
+          SET tkn_id = ?, tkn_dh_secret = ?, tkn_status = ?, tkn_action = ?, updated_at = ?
+          WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
+        |]
+        (tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
+
+  updateNtfToken :: SQLiteStore -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> m ()
+  updateNtfToken st NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknStatus tknAction =
+    liftIO . withTransaction st $ \db -> do
+      updatedAt <- getCurrentTime
+      DB.execute
+        db
+        [sql|
+          UPDATE ntf_tokens
+          SET tkn_status = ?, tkn_action = ?, updated_at = ?
+          WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
+        |]
+        (tknStatus, tknAction, updatedAt, provider, token, host, port)
+
 -- * Auxiliary helpers
 
 instance ToField QueueStatus where toField = toField . serializeQueueStatus
@@ -611,14 +669,6 @@ instance ToField (SConnectionMode c) where toField = toField . connMode
 
 instance FromField AConnectionMode where fromField = fromTextField_ $ fmap connMode' . connModeT
 
-fromTextField_ :: (E.Typeable a) => (Text -> Maybe a) -> Field -> Ok a
-fromTextField_ fromText = \case
-  f@(Field (SQLText t) _) ->
-    case fromText t of
-      Just x -> Ok x
-      _ -> returnError ConversionFailed f ("invalid text: " <> T.unpack t)
-  f -> returnError ConversionFailed f "expecting SQLText column type"
-
 listToEither :: e -> [a] -> Either e a
 listToEither _ (x : _) = Right x
 listToEither e _ = Left e
@@ -669,6 +719,19 @@ upsertServer_ dbConn ProtocolServer {host, port, keyHash} = do
     |]
     [":host" := host, ":port" := port, ":key_hash" := keyHash]
 
+upsertNtfServer_ :: DB.Connection -> NtfServer -> IO ()
+upsertNtfServer_ db ProtocolServer {host, port, keyHash} = do
+  DB.executeNamed
+    db
+    [sql|
+      INSERT INTO ntf_servers (ntf_host, ntf_port, ntf_key_hash) VALUES (:host,:port,:key_hash)
+      ON CONFLICT (ntf_host, ntf_port) DO UPDATE SET
+        ntf_host=excluded.ntf_host,
+        ntf_port=excluded.ntf_port,
+        ntf_key_hash=excluded.ntf_key_hash;
+    |]
+    [":host" := host, ":port" := port, ":key_hash" := keyHash]
+
 -- * createRcvConn helpers
 
 insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
index 8fd996810..3587e05b1 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
@@ -8,40 +8,29 @@ import Database.SQLite.Simple.QQ (sql)
 m20220322_notifications :: Query
 m20220322_notifications =
   [sql|
-ALTER TABLE rcv_queues ADD COLUMN ntf_id BLOB;
-
-ALTER TABLE rcv_queues ADD COLUMN ntf_public_key BLOB;
-
-ALTER TABLE rcv_queues ADD COLUMN ntf_private_key BLOB;
-
-CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues (host, port, ntf_id);
-
 CREATE TABLE ntf_servers (
   ntf_host TEXT NOT NULL,
   ntf_port TEXT NOT NULL,
   ntf_key_hash BLOB NOT NULL,
-  created_at TEXT NOT NULL,
-  updated_at TEXT NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now')),
   PRIMARY KEY (ntf_host, ntf_port)
 ) WITHOUT ROWID;
 
-CREATE TABLE ntf_subscriptions (
+CREATE TABLE ntf_tokens (
+  provider TEXT NOT NULL, -- apn
+  device_token TEXT NOT NULL,
   ntf_host TEXT NOT NULL,
   ntf_port TEXT NOT NULL,
-  ntf_sub_id BLOB NOT NULL,
-  ntf_sub_status TEXT NOT NULL, -- new, created, active, pending, error_auth
-  ntf_sub_action TEXT, -- if there is an action required on this subscription: create / check / token / delete
-  ntf_sub_action_ts TEXT, -- the earliest time for the action, e.g. checks can be scheduled every X hours
-  ntf_token TEXT NOT NULL, -- or BLOB?
-  smp_host TEXT NOT NULL,
-  smp_port TEXT NOT NULL,
-  smp_ntf_id BLOB NOT NULL,
-  created_at TEXT NOT NULL,
-  updated_at TEXT NOT NULL, -- this is to check subscription status periodically to know when it was last checked
-  PRIMARY KEY (ntf_host, ntf_port, ntf_sub_id),
+  tkn_id BLOB, -- token ID assigned by notifications server
+  tkn_priv_key BLOB NOT NULL, -- private key to sign token commands
+  tkn_dh_secret BLOB, -- DH secret for e2e encryption of notifications
+  tkn_status TEXT NOT NULL,
+  tkn_action BLOB,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now')), -- this is to check token status periodically to know when it was last checked
+  PRIMARY KEY (provider, device_token, ntf_host, ntf_port),
   FOREIGN KEY (ntf_host, ntf_port) REFERENCES ntf_servers
-    ON DELETE RESTRICT ON UPDATE CASCADE,
-  FOREIGN KEY (smp_host, smp_port, smp_ntf_id) REFERENCES rcv_queues (host, port, ntf_id)
     ON DELETE RESTRICT ON UPDATE CASCADE
 ) WITHOUT ROWID;
 |]
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs
new file mode 100644
index 000000000..5f58ca0fd
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220404_ntf_subscriptions_draft where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220404_ntf_subscriptions_draft :: Query
+m20220404_ntf_subscriptions_draft =
+  [sql|
+ALTER TABLE rcv_queues ADD COLUMN ntf_id BLOB;
+
+ALTER TABLE rcv_queues ADD COLUMN ntf_public_key BLOB;
+
+ALTER TABLE rcv_queues ADD COLUMN ntf_private_key BLOB;
+
+CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues (host, port, ntf_id);
+
+CREATE TABLE ntf_subscriptions (
+  ntf_host TEXT NOT NULL,
+  ntf_port TEXT NOT NULL,
+  ntf_sub_id BLOB NOT NULL,
+  ntf_sub_status TEXT NOT NULL, -- new, created, active, pending, error_auth
+  ntf_sub_action TEXT, -- if there is an action required on this subscription: create / check / token / delete
+  ntf_sub_action_ts TEXT, -- the earliest time for the action, e.g. checks can be scheduled every X hours
+  ntf_token TEXT NOT NULL, -- or BLOB?
+  smp_host TEXT NOT NULL,
+  smp_port TEXT NOT NULL,
+  smp_ntf_id BLOB NOT NULL,
+  created_at TEXT NOT NULL,
+  updated_at TEXT NOT NULL, -- this is to check subscription status periodically to know when it was last checked
+  PRIMARY KEY (ntf_host, ntf_port, ntf_sub_id),
+  FOREIGN KEY (ntf_host, ntf_port) REFERENCES ntf_servers
+    ON DELETE RESTRICT ON UPDATE CASCADE,
+  FOREIGN KEY (smp_host, smp_port, smp_ntf_id) REFERENCES rcv_queues (host, port, ntf_id)
+    ON DELETE RESTRICT ON UPDATE CASCADE
+) WITHOUT ROWID;
+|]
\ No newline at end of file
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 75ce01126..4174e8555 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -66,7 +66,7 @@ import Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError)
-import Simplex.Messaging.Transport.Client (runTransportClient, smpClientHandshake)
+import Simplex.Messaging.Transport.Client (runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
@@ -132,11 +132,11 @@ type Response msg = Either ProtocolClientError msg
 -- as 'SMPServerTransmission' includes server information.
 getProtocolClient :: forall msg. Protocol msg => ProtocolServer -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> IO () -> IO (Either ProtocolClientError (ProtocolClient msg))
 getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing} msgQ disconnected =
-  (atomically mkSMPClient >>= runClient useTransport)
+  (atomically mkProtocolClient >>= runClient useTransport)
     `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
   where
-    mkSMPClient :: STM (ProtocolClient msg)
-    mkSMPClient = do
+    mkProtocolClient :: STM (ProtocolClient msg)
+    mkProtocolClient = do
       connected <- newTVar False
       clientCorrId <- newTVar 0
       sentCommands <- TM.empty
@@ -177,7 +177,7 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
 
     client :: forall c. Transport c => TProxy c -> ProtocolClient msg -> TMVar (Either ProtocolClientError (THandle c)) -> c -> IO ()
     client _ c thVar h =
-      runExceptT (smpClientHandshake h $ keyHash protocolServer) >>= \case
+      runExceptT (protocolClientHandshake @msg h $ keyHash protocolServer) >>= \case
         Left e -> atomically . putTMVar thVar . Left $ PCETransportError e
         Right th@THandle {sessionId} -> do
           atomically $ do
diff --git a/src/Simplex/Messaging/Encoding/String.hs b/src/Simplex/Messaging/Encoding/String.hs
index 9e7d32c3f..52b26ef1d 100644
--- a/src/Simplex/Messaging/Encoding/String.hs
+++ b/src/Simplex/Messaging/Encoding/String.hs
@@ -2,7 +2,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Messaging.Encoding.String
-  ( StrEncoding (..),
+  ( TextEncoding (..),
+    StrEncoding (..),
     Str (..),
     strP_,
     strToJSON,
@@ -26,11 +27,16 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlphaNum)
 import qualified Data.List.NonEmpty as L
+import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Word (Word16)
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Util ((<$?>))
 
+class TextEncoding a where
+  textEncode :: a -> Text
+  textDecode :: Text -> Maybe a
+
 -- | Serializing human-readable and (where possible) URI-friendly strings for SMP and SMP agent protocols
 class StrEncoding a where
   {-# MINIMAL strEncode, (strDecode | strP) #-}
diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs
index 48fc89b1e..76667f9fb 100644
--- a/src/Simplex/Messaging/Notifications/Client.hs
+++ b/src/Simplex/Messaging/Notifications/Client.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -7,42 +9,50 @@ module Simplex.Messaging.Notifications.Client where
 
 import Control.Monad.Except
 import Control.Monad.Trans.Except
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Word (Word16)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Parsers (blobFieldDecoder)
+import Simplex.Messaging.Protocol (ProtocolServer)
+
+type NtfServer = ProtocolServer
 
 type NtfClient = ProtocolClient NtfResponse
 
-registerNtfToken :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Token -> ExceptT ProtocolClientError IO (NtfTokenId, C.PublicKeyX25519)
-registerNtfToken c pKey newTkn =
+ntfRegisterToken :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Token -> ExceptT ProtocolClientError IO (NtfTokenId, C.PublicKeyX25519)
+ntfRegisterToken c pKey newTkn =
   sendNtfCommand c (Just pKey) "" (TNEW newTkn) >>= \case
     NRId tknId dhKey -> pure (tknId, dhKey)
     _ -> throwE PCEUnexpectedResponse
 
-verifyNtfToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> NtfRegistrationCode -> ExceptT ProtocolClientError IO ()
-verifyNtfToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
+ntfVerifyToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> NtfRegCode -> ExceptT ProtocolClientError IO ()
+ntfVerifyToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
 
-deleteNtfToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> ExceptT ProtocolClientError IO ()
-deleteNtfToken = okNtfCommand TDEL
+ntfDeleteToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> ExceptT ProtocolClientError IO ()
+ntfDeleteToken = okNtfCommand TDEL
 
-enableNtfCron :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> Word16 -> ExceptT ProtocolClientError IO ()
-enableNtfCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
+ntfEnableCron :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> Word16 -> ExceptT ProtocolClientError IO ()
+ntfEnableCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
 
-createNtfSubsciption :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO (NtfSubscriptionId, C.PublicKeyX25519)
-createNtfSubsciption c pKey newSub =
+ntfCreateSubsciption :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO (NtfSubscriptionId, C.PublicKeyX25519)
+ntfCreateSubsciption c pKey newSub =
   sendNtfCommand c (Just pKey) "" (SNEW newSub) >>= \case
     NRId tknId dhKey -> pure (tknId, dhKey)
     _ -> throwE PCEUnexpectedResponse
 
-checkNtfSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO NtfSubStatus
-checkNtfSubscription c pKey subId =
+ntfCheckSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO NtfSubStatus
+ntfCheckSubscription c pKey subId =
   sendNtfCommand c (Just pKey) subId SCHK >>= \case
     NRStat stat -> pure stat
     _ -> throwE PCEUnexpectedResponse
 
-deleteNfgSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO ()
-deleteNfgSubscription = okNtfCommand SDEL
+ntfDeleteSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO ()
+ntfDeleteSubscription = okNtfCommand SDEL
 
 -- | Send notification server command
 sendNtfCommand :: NtfEntityI e => NtfClient -> Maybe C.APrivateSignKey -> NtfEntityId -> NtfCommand e -> ExceptT ProtocolClientError IO NtfResponse
@@ -53,3 +63,58 @@ okNtfCommand cmd c pKey entId =
   sendNtfCommand c (Just pKey) entId cmd >>= \case
     NROk -> return ()
     _ -> throwE PCEUnexpectedResponse
+
+data NtfTknAction
+  = NTARegister C.APublicVerifyKey -- public key to send to the server
+  | NTAVerify NtfRegCode -- code to verify token
+  | NTACheck
+  | NTACron Word16
+  | NTADelete
+  deriving (Show)
+
+instance Encoding NtfTknAction where
+  smpEncode = \case
+    NTARegister key -> smpEncode ('R', key)
+    NTAVerify code -> smpEncode ('V', code)
+    NTACheck -> "C"
+    NTACron interval -> smpEncode ('I', interval)
+    NTADelete -> "D"
+  smpP =
+    A.anyChar >>= \case
+      'R' -> NTARegister <$> smpP
+      'V' -> NTAVerify <$> smpP
+      'C' -> pure NTACheck
+      'I' -> NTACron <$> smpP
+      'D' -> pure NTADelete
+      _ -> fail "bad NtfTknAction"
+
+instance FromField NtfTknAction where fromField = blobFieldDecoder smpDecode
+
+instance ToField NtfTknAction where toField = toField . smpEncode
+
+data NtfToken = NtfToken
+  { deviceToken :: DeviceToken,
+    ntfServer :: NtfServer,
+    ntfTokenId :: Maybe NtfTokenId,
+    -- | key used by the ntf client to sign transmissions
+    ntfPrivKey :: C.APrivateSignKey,
+    -- | shared DH secret used to encrypt/decrypt notifications e2e
+    ntfDhSecret :: Maybe C.DhSecretX25519,
+    -- | token status
+    ntfTknStatus :: NtfTknStatus,
+    -- | pending token action and the earliest time
+    ntfTknAction :: Maybe NtfTknAction
+  }
+  deriving (Show)
+
+newNtfToken :: DeviceToken -> NtfServer -> C.APrivateSignKey -> C.APublicVerifyKey -> NtfToken
+newNtfToken deviceToken ntfServer ntfPrivKey ntfPubKey =
+  NtfToken
+    { deviceToken,
+      ntfServer,
+      ntfTokenId = Nothing,
+      ntfPrivKey,
+      ntfDhSecret = Nothing,
+      ntfTknStatus = NTNew,
+      ntfTknAction = Just $ NTARegister ntfPubKey
+    }
\ No newline at end of file
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 1fac10e7e..17c6ece56 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -10,6 +10,7 @@
 
 module Simplex.Messaging.Notifications.Protocol where
 
+import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -17,8 +18,13 @@ import Data.Kind
 import Data.Maybe (isNothing)
 import Data.Type.Equality
 import Data.Word (Word16)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Notifications.Transport (ntfClientHandshake)
+import Simplex.Messaging.Parsers (fromTextField_)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util ((<$?>))
 
@@ -87,12 +93,31 @@ instance ProtocolMsgTag NtfCmdTag where
 instance NtfEntityI e => ProtocolMsgTag (NtfCommandTag e) where
   decodeTag s = decodeTag s >>= (\(NCT _ t) -> checkEntity' t)
 
-type NtfRegistrationCode = ByteString
+newtype NtfRegCode = NtfRegCode ByteString
+  deriving (Eq, Show)
+
+instance Encoding NtfRegCode where
+  smpEncode (NtfRegCode code) = smpEncode code
+  smpP = NtfRegCode <$> smpP
+
+instance StrEncoding NtfRegCode where
+  strEncode (NtfRegCode m) = strEncode m
+  strDecode s = NtfRegCode <$> strDecode s
+  strP = NtfRegCode <$> strP
+
+instance FromJSON NtfRegCode where
+  parseJSON = strParseJSON "NtfRegCode"
+
+instance ToJSON NtfRegCode where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
 
 data NewNtfEntity (e :: NtfEntity) where
   NewNtfTkn :: DeviceToken -> C.APublicVerifyKey -> C.PublicKeyX25519 -> NewNtfEntity 'Token
   NewNtfSub :: NtfTokenId -> SMPQueueNtf -> NewNtfEntity 'Subscription
 
+deriving instance Show (NewNtfEntity e)
+
 data ANewNtfEntity = forall e. NtfEntityI e => ANE (SNtfEntity e) (NewNtfEntity e)
 
 instance NtfEntityI e => Encoding (NewNtfEntity e) where
@@ -111,6 +136,7 @@ instance Encoding ANewNtfEntity where
 
 instance Protocol NtfResponse where
   type ProtocolCommand NtfResponse = NtfCmd
+  protocolClientHandshake = ntfClientHandshake
   protocolPing = NtfCmd SSubscription PING
   protocolError = \case
     NRErr e -> Just e
@@ -120,7 +146,7 @@ data NtfCommand (e :: NtfEntity) where
   -- | register new device token for notifications
   TNEW :: NewNtfEntity 'Token -> NtfCommand 'Token
   -- | verify token - uses e2e encrypted random string sent to the device via PN to confirm that the device has the token
-  TVFY :: NtfRegistrationCode -> NtfCommand 'Token
+  TVFY :: NtfRegCode -> NtfCommand 'Token
   -- | delete token - all subscriptions will be removed and no more notifications will be sent
   TDEL :: NtfCommand 'Token
   -- | enable periodic background notification to fetch the new messages - interval is in minutes, minimum is 20, 0 to disable
@@ -134,8 +160,12 @@ data NtfCommand (e :: NtfEntity) where
   -- | keep-alive command
   PING :: NtfCommand 'Subscription
 
+deriving instance Show (NtfCommand e)
+
 data NtfCmd = forall e. NtfEntityI e => NtfCmd (SNtfEntity e) (NtfCommand e)
 
+deriving instance Show NtfCmd
+
 instance NtfEntityI e => ProtocolEncoding (NtfCommand e) where
   type Tag (NtfCommand e) = NtfCommandTag e
   encodeProtocol = \case
@@ -263,6 +293,7 @@ data SMPQueueNtf = SMPQueueNtf
     notifierId :: NotifierId,
     notifierKey :: NtfPrivateSignKey
   }
+  deriving (Show)
 
 instance Encoding SMPQueueNtf where
   smpEncode SMPQueueNtf {smpServer, notifierId, notifierKey} = smpEncode (smpServer, notifierId, notifierKey)
@@ -270,17 +301,30 @@ instance Encoding SMPQueueNtf where
     (smpServer, notifierId, notifierKey) <- smpP
     pure $ SMPQueueNtf smpServer notifierId notifierKey
 
-data PushPlatform = PPApple
+data PushProvider = PPApple
+  deriving (Eq, Ord, Show)
 
-instance Encoding PushPlatform where
+instance Encoding PushProvider where
   smpEncode = \case
     PPApple -> "A"
   smpP =
     A.anyChar >>= \case
       'A' -> pure PPApple
-      _ -> fail "bad PushPlatform"
+      _ -> fail "bad PushProvider"
 
-data DeviceToken = DeviceToken PushPlatform ByteString
+instance TextEncoding PushProvider where
+  textEncode = \case
+    PPApple -> "apple"
+  textDecode = \case
+    "apple" -> Just PPApple
+    _ -> Nothing
+
+instance FromField PushProvider where fromField = fromTextField_ textDecode
+
+instance ToField PushProvider where toField = toField . textEncode
+
+data DeviceToken = DeviceToken PushProvider ByteString
+  deriving (Eq, Ord, Show)
 
 instance Encoding DeviceToken where
   smpEncode (DeviceToken p t) = smpEncode (p, t)
@@ -322,17 +366,40 @@ instance Encoding NtfSubStatus where
       _ -> fail "bad NtfError"
 
 data NtfTknStatus
-  = -- | state after registration (TNEW)
+  = -- | Token created in DB
     NTNew
-  | -- | if initial notification or verification failed (push provider error)
+  | -- | state after registration (TNEW)
+    NTRegistered
+  | -- | if initial notification failed (push provider error) or verification failed
     NTInvalid
-  | -- | if initial notification succeeded
+  | -- | Token confirmed via notification (accepted by push provider or verification code received by client)
     NTConfirmed
   | -- | after successful verification (TVFY)
     NTActive
   | -- | after it is no longer valid (push provider error)
     NTExpired
-  deriving (Eq)
+  deriving (Eq, Show)
+
+instance TextEncoding NtfTknStatus where
+  textEncode = \case
+    NTNew -> "new"
+    NTRegistered -> "registered"
+    NTInvalid -> "invalid"
+    NTConfirmed -> "confirmed"
+    NTActive -> "active"
+    NTExpired -> "expired"
+  textDecode = \case
+    "new" -> Just NTNew
+    "registered" -> Just NTRegistered
+    "invalid" -> Just NTInvalid
+    "confirmed" -> Just NTConfirmed
+    "active" -> Just NTActive
+    "expired" -> Just NTExpired
+    _ -> Nothing
+
+instance FromField NtfTknStatus where fromField = fromTextField_ textDecode
+
+instance ToField NtfTknStatus where toField = toField . textEncode
 
 checkEntity :: forall t e e'. (NtfEntityI e, NtfEntityI e') => t e' -> Either String (t e)
 checkEntity c = case testEquality (sNtfEntity @e) (sNtfEntity @e') of
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 13d4671e6..916c64111 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -14,8 +14,8 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
+import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
-import Data.Functor (($>))
 import Network.Socket (ServiceName)
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
@@ -106,7 +106,12 @@ ntfSubscriber NtfSubscriber {subQ, smpAgent = ca@SMPClientAgent {msgQ, agentQ}}
 ntfPush :: (MonadUnliftIO m, MonadReader NtfEnv m) => NtfPushServer -> m ()
 ntfPush NtfPushServer {pushQ} = forever $ do
   atomically (readTBQueue pushQ) >>= \case
-    (NtfTknData {}, Notification {}) -> pure ()
+    (NtfTknData {tknStatus}, notification) -> do
+      liftIO $ print $ J.encode notification
+      -- TODO status update should happen after the token status successfully sent
+      case notification of
+        PNVerification _ -> atomically $ writeTVar tknStatus NTConfirmed
+        _ -> pure ()
 
 runNtfClientTransport :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> m ()
 runNtfClientTransport th@THandle {sessionId} = do
@@ -122,7 +127,7 @@ clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connecte
 
 receive :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> NtfServerClient -> m ()
 receive th NtfServerClient {rcvQ, sndQ} = forever $ do
-  t@(sig, signed, (corrId, subId, cmdOrError)) <- tGet th
+  t@(_, _, (corrId, subId, cmdOrError)) <- tGet th
   case cmdOrError of
     Left e -> write sndQ (corrId, subId, NRErr e)
     Right cmd ->
@@ -144,7 +149,7 @@ verifyNtfTransmission ::
 verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do
   case cmd of
     NtfCmd SToken (TNEW n@(NewNtfTkn _ k _)) ->
-      -- TODO check that token is not already in store
+      -- TODO check that token is not already in store, if it is - verify that the saved key is the same
       pure $
         if verifyCmdSignature sig_ signed k
           then VRVerified (NtfReqNew corrId (ANE SToken n))
@@ -189,16 +194,21 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ} NtfPushServer {pushQ} =
         (srvDhPubKey, srvDrivDhKey) <- liftIO C.generateKeyPair'
         let dhSecret = C.dh' dhPubKey srvDrivDhKey
         tknId <- getId
+        regCode <- getRegCode
         atomically $ do
-          tkn <- mkNtfTknData newTkn dhSecret
+          tkn <- mkNtfTknData newTkn dhSecret regCode
           addNtfToken st tknId tkn
-          writeTBQueue pushQ (tkn, Notification)
-        --     pure (corrId, sId, NRSubId pubDhKey)
+          writeTBQueue pushQ (tkn, PNVerification regCode)
         pure (corrId, "", NRId tknId srvDhPubKey)
-      NtfReqCmd SToken tkn (corrId, tknId, cmd) ->
+      NtfReqCmd SToken (NtfTkn NtfTknData {tknStatus, tknRegCode}) (corrId, tknId, cmd) -> do
+        status <- readTVarIO tknStatus
         (corrId,tknId,) <$> case cmd of
           TNEW newTkn -> pure NROk -- TODO when duplicate token sent
-          TVFY code -> pure NROk
+          TVFY code -- this allows repeated verification for cases when client connection dropped before server response
+            | (status == NTRegistered || status == NTConfirmed || status == NTActive) && tknRegCode == code -> do
+              atomically $ writeTVar tknStatus NTActive
+              pure NROk
+            | otherwise -> pure $ NRErr AUTH
           TDEL -> pure NROk
           TCRN int -> pure NROk
       NtfReqNew corrId (ANE SSubscription newSub) -> pure (corrId, "", NROk)
@@ -209,8 +219,11 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ} NtfPushServer {pushQ} =
           SDEL -> pure NROk
           PING -> pure NRPong
     getId :: m NtfEntityId
-    getId = do
-      n <- asks $ subIdBytes . config
+    getId = getRandomBytes =<< asks (subIdBytes . config)
+    getRegCode :: m NtfRegCode
+    getRegCode = NtfRegCode <$> (getRandomBytes =<< asks (regCodeBytes . config))
+    getRandomBytes :: Int -> m ByteString
+    getRandomBytes n = do
       gVar <- asks idsDrg
       atomically (randomBytes n gVar)
 
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 8b2a416a1..e76c63375 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
@@ -8,8 +9,11 @@ module Simplex.Messaging.Notifications.Server.Env where
 
 import Control.Monad.IO.Unlift
 import Crypto.Random
+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import Data.X509.Validation (Fingerprint (..))
+import GHC.Generics
 import Network.Socket
 import qualified Network.TLS as T
 import Numeric.Natural
@@ -17,6 +21,7 @@ import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Subscriptions
+import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
 import Simplex.Messaging.Protocol (CorrId, Transmission)
 import Simplex.Messaging.Transport (ATransport)
 import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
@@ -25,6 +30,7 @@ import UnliftIO.STM
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ATransport)],
     subIdBytes :: Int,
+    regCodeBytes :: Int,
     clientQSize :: Natural,
     subQSize :: Natural,
     pushQSize :: Natural,
@@ -35,7 +41,15 @@ data NtfServerConfig = NtfServerConfig
     certificateFile :: FilePath
   }
 
-data Notification = Notification
+data PushNotification = PNVerification {code :: NtfRegCode} | PNPeriodic
+  deriving (Show, Generic)
+
+instance FromJSON PushNotification where
+  parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "PN"
+
+instance ToJSON PushNotification where
+  toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "PN"
+  toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "PN"
 
 data NtfEnv = NtfEnv
   { config :: NtfServerConfig,
@@ -70,7 +84,7 @@ newNtfSubscriber qSize smpAgentCfg = do
   pure NtfSubscriber {smpAgent, subQ}
 
 newtype NtfPushServer = NtfPushServer
-  { pushQ :: TBQueue (NtfTknData, Notification)
+  { pushQ :: TBQueue (NtfTknData, PushNotification)
   }
 
 newNtfPushServer :: Natural -> STM NtfPushServer
diff --git a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
index e5cbd26fc..fa5790d85 100644
--- a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
@@ -36,15 +36,16 @@ data NtfTknData = NtfTknData
   { token :: DeviceToken,
     tknStatus :: TVar NtfTknStatus,
     tknVerifyKey :: C.APublicVerifyKey,
-    tknDhSecret :: C.DhSecretX25519
+    tknDhSecret :: C.DhSecretX25519,
+    tknRegCode :: NtfRegCode
   }
 
-mkNtfTknData :: NewNtfEntity 'Token -> C.DhSecretX25519 -> STM NtfTknData
-mkNtfTknData (NewNtfTkn token tknVerifyKey _) tknDhSecret = do
-  tknStatus <- newTVar NTNew
-  pure NtfTknData {token, tknStatus, tknVerifyKey, tknDhSecret}
+mkNtfTknData :: NewNtfEntity 'Token -> C.DhSecretX25519 -> NtfRegCode -> STM NtfTknData
+mkNtfTknData (NewNtfTkn token tknVerifyKey _) tknDhSecret tknRegCode = do
+  tknStatus <- newTVar NTRegistered
+  pure NtfTknData {token, tknStatus, tknVerifyKey, tknDhSecret, tknRegCode}
 
-data NtfSubscriptionsStore = NtfSubscriptionsStore
+-- data NtfSubscriptionsStore = NtfSubscriptionsStore
 
 -- { subscriptions :: TMap NtfSubsciptionId NtfSubsciption,
 --   activeSubscriptions :: TMap (SMPServer, NotifierId) NtfSubsciptionId
@@ -70,7 +71,9 @@ getNtfToken :: NtfStore -> NtfTokenId -> STM (Maybe (NtfEntityRec 'Token))
 getNtfToken st tknId = NtfTkn <$$> TM.lookup tknId (tokens st)
 
 addNtfToken :: NtfStore -> NtfTokenId -> NtfTknData -> STM ()
-addNtfToken st tknId tkn = pure ()
+addNtfToken st tknId tkn@NtfTknData {token} = do
+  TM.insert tknId tkn (tokens st)
+  TM.insert token tknId (tokenIds st)
 
 -- getNtfRec :: NtfStore -> SNtfEntity e -> NtfEntityId -> STM (Maybe (NtfEntityRec e))
 -- getNtfRec st ent entId = case ent of
diff --git a/src/Simplex/Messaging/Parsers.hs b/src/Simplex/Messaging/Parsers.hs
index ab4c1a4b5..ed0606fb2 100644
--- a/src/Simplex/Messaging/Parsers.hs
+++ b/src/Simplex/Messaging/Parsers.hs
@@ -13,6 +13,8 @@ import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlphaNum, toLower)
+import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601 (parseISO8601)
 import Data.Typeable (Typeable)
@@ -81,6 +83,14 @@ blobFieldDecoder dec = \case
       Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
 
+fromTextField_ :: (Typeable a) => (Text -> Maybe a) -> Field -> Ok a
+fromTextField_ fromText = \case
+  f@(Field (SQLText t) _) ->
+    case fromText t of
+      Just x -> Ok x
+      _ -> returnError ConversionFailed f ("invalid text: " <> T.unpack t)
+  f -> returnError ConversionFailed f "expecting SQLText column type"
+
 fstToLower :: String -> String
 fstToLower "" = ""
 fstToLower (h : t) = toLower h : t
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 0e94b5192..869855ee0 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -115,7 +116,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
-import Simplex.Messaging.Transport (THandle (..), Transport, TransportError (..), tGetBlock, tPutBlock)
+import Simplex.Messaging.Transport (THandle (..), Transport, TransportError (..), smpClientHandshake, tGetBlock, tPutBlock)
 import Simplex.Messaging.Util (bshow, (<$?>))
 import Simplex.Messaging.Version
 import Test.QuickCheck (Arbitrary (..))
@@ -184,6 +185,7 @@ data RawTransmission = RawTransmission
     entityId :: ByteString,
     command :: ByteString
   }
+  deriving (Show)
 
 -- | unparsed sent SMP transmission with signature, without session ID.
 type SignedRawTransmission = (Maybe C.ASignature, ByteString, ByteString, ByteString)
@@ -554,11 +556,13 @@ transmissionP = do
 
 class (ProtocolEncoding msg, ProtocolEncoding (ProtocolCommand msg)) => Protocol msg where
   type ProtocolCommand msg = cmd | cmd -> msg
+  protocolClientHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
   protocolPing :: ProtocolCommand msg
   protocolError :: msg -> Maybe ErrorType
 
 instance Protocol BrokerMsg where
   type ProtocolCommand BrokerMsg = Cmd
+  protocolClientHandshake = smpClientHandshake
   protocolPing = Cmd SSender PING
   protocolError = \case
     ERR e -> Just e
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 1ebe91f24..a37bcff19 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -9,11 +9,13 @@ module AgentTests.FunctionalAPITests (functionalAPITests) where
 
 import Control.Monad.Except (ExceptT, runExceptT)
 import Control.Monad.IO.Unlift
+import NtfClient (withNtfServer)
 import SMPAgentClient
 import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (DeviceToken), PushProvider (PPApple))
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..))
 import System.Timeout
@@ -48,11 +50,14 @@ functionalAPITests t = do
       testAsyncServerOffline t
     it "should notify after HELLO timeout" $
       withSmpServer t testAsyncHelloTimeout
+  describe "Notification server" $ do
+    it "should register device token" $
+      withNtfServer t testNotificationToken
 
 testAgentClient :: IO ()
 testAgentClient = do
-  alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  alice <- getSMPAgentClient cfg initAgentServers
+  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
   Right () <- runExceptT $ do
     (bobId, qInfo) <- createConnection alice SCMInvitation
     aliceId <- joinConnection bob qInfo "bob's connInfo"
@@ -95,13 +100,13 @@ testAgentClient = do
 
 testAsyncInitiatingOffline :: IO ()
 testAsyncInitiatingOffline = do
-  alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  alice <- getSMPAgentClient cfg initAgentServers
+  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
   Right () <- runExceptT $ do
     (bobId, cReq) <- createConnection alice SCMInvitation
     disconnectAgentClient alice
     aliceId <- joinConnection bob cReq "bob's connInfo"
-    alice' <- liftIO $ getSMPAgentClient cfg
+    alice' <- liftIO $ getSMPAgentClient cfg initAgentServers
     subscribeConnection alice' bobId
     ("", _, CONF confId "bob's connInfo") <- get alice'
     allowConnection alice' bobId confId "alice's connInfo"
@@ -113,15 +118,15 @@ testAsyncInitiatingOffline = do
 
 testAsyncJoiningOfflineBeforeActivation :: IO ()
 testAsyncJoiningOfflineBeforeActivation = do
-  alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  alice <- getSMPAgentClient cfg initAgentServers
+  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
   Right () <- runExceptT $ do
     (bobId, qInfo) <- createConnection alice SCMInvitation
     aliceId <- joinConnection bob qInfo "bob's connInfo"
     disconnectAgentClient bob
     ("", _, CONF confId "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
-    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
+    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
     subscribeConnection bob' aliceId
     get alice ##> ("", bobId, CON)
     get bob' ##> ("", aliceId, INFO "alice's connInfo")
@@ -131,18 +136,18 @@ testAsyncJoiningOfflineBeforeActivation = do
 
 testAsyncBothOffline :: IO ()
 testAsyncBothOffline = do
-  alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  alice <- getSMPAgentClient cfg initAgentServers
+  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
   Right () <- runExceptT $ do
     (bobId, cReq) <- createConnection alice SCMInvitation
     disconnectAgentClient alice
     aliceId <- joinConnection bob cReq "bob's connInfo"
     disconnectAgentClient bob
-    alice' <- liftIO $ getSMPAgentClient cfg
+    alice' <- liftIO $ getSMPAgentClient cfg initAgentServers
     subscribeConnection alice' bobId
     ("", _, CONF confId "bob's connInfo") <- get alice'
     allowConnection alice' bobId confId "alice's connInfo"
-    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2}
+    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
     subscribeConnection bob' aliceId
     get alice' ##> ("", bobId, CON)
     get bob' ##> ("", aliceId, INFO "alice's connInfo")
@@ -152,8 +157,8 @@ testAsyncBothOffline = do
 
 testAsyncServerOffline :: ATransport -> IO ()
 testAsyncServerOffline t = do
-  alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2}
+  alice <- getSMPAgentClient cfg initAgentServers
+  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
   -- create connection and shutdown the server
   Right (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ ->
     runExceptT $ createConnection alice SCMInvitation
@@ -176,8 +181,8 @@ testAsyncServerOffline t = do
 
 testAsyncHelloTimeout :: IO ()
 testAsyncHelloTimeout = do
-  alice <- getSMPAgentClient cfg
-  bob <- getSMPAgentClient cfg {dbFile = testDB2, helloTimeout = 1}
+  alice <- getSMPAgentClient cfg initAgentServers
+  bob <- getSMPAgentClient cfg {dbFile = testDB2, helloTimeout = 1} initAgentServers
   Right () <- runExceptT $ do
     (_, cReq) <- createConnection alice SCMInvitation
     disconnectAgentClient alice
@@ -185,6 +190,13 @@ testAsyncHelloTimeout = do
     get bob ##> ("", aliceId, ERR $ CONN NOT_ACCEPTED)
   pure ()
 
+testNotificationToken :: IO ()
+testNotificationToken = do
+  alice <- getSMPAgentClient cfg initAgentServers
+  Right () <- runExceptT $ do
+    registerNtfToken alice $ DeviceToken PPApple "abcd"
+  pure ()
+
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetings alice bobId bob aliceId = do
   5 <- sendMessage alice bobId "hello"
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
new file mode 100644
index 000000000..bb7f6dec6
--- /dev/null
+++ b/tests/NtfClient.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module NtfClient where
+
+import Control.Monad.Except (runExceptT)
+import Control.Monad.IO.Unlift
+import Crypto.Random
+import Data.ByteString.Char8 (ByteString)
+import Network.Socket
+import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
+import Simplex.Messaging.Notifications.Server.Env
+import Simplex.Messaging.Notifications.Transport
+import Simplex.Messaging.Protocol
+import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Client
+import Simplex.Messaging.Transport.KeepAlive
+import UnliftIO.Concurrent
+import qualified UnliftIO.Exception as E
+import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, takeTMVar)
+import UnliftIO.Timeout (timeout)
+
+testHost :: HostName
+testHost = "localhost"
+
+testPort :: ServiceName
+testPort = "6001"
+
+testKeyHash :: C.KeyHash
+testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
+
+testNtfClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
+testNtfClient client =
+  runTransportClient testHost testPort testKeyHash (Just defaultKeepAliveOpts) $ \h ->
+    liftIO (runExceptT $ ntfClientHandshake h testKeyHash) >>= \case
+      Right th -> client th
+      Left e -> error $ show e
+
+cfg :: NtfServerConfig
+cfg =
+  NtfServerConfig
+    { transports = undefined,
+      subIdBytes = 24,
+      regCodeBytes = 32,
+      clientQSize = 1,
+      subQSize = 1,
+      pushQSize = 1,
+      smpAgentCfg = defaultSMPClientAgentConfig,
+      -- CA certificate private key is not needed for initialization
+      caCertificateFile = "tests/fixtures/ca.crt",
+      privateKeyFile = "tests/fixtures/server.key",
+      certificateFile = "tests/fixtures/server.crt"
+    }
+
+withNtfServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
+withNtfServerThreadOn t port' =
+  serverBracket
+    (\started -> runNtfServerBlocking started cfg {transports = [(port', t)]})
+    (pure ())
+
+serverBracket :: MonadUnliftIO m => (TMVar Bool -> m ()) -> m () -> (ThreadId -> m a) -> m a
+serverBracket process afterProcess f = do
+  started <- newEmptyTMVarIO
+  E.bracket
+    (forkIOWithUnmask ($ process started))
+    (\t -> killThread t >> afterProcess >> waitFor started "stop")
+    (\t -> waitFor started "start" >> f t)
+  where
+    waitFor started s =
+      5_000_000 `timeout` atomically (takeTMVar started) >>= \case
+        Nothing -> error $ "server did not " <> s
+        _ -> pure ()
+
+withNtfServerOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> m a -> m a
+withNtfServerOn t port' = withNtfServerThreadOn t port' . const
+
+withNtfServer :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
+withNtfServer t = withNtfServerOn t testPort
+
+runNtfTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => (THandle c -> m a) -> m a
+runNtfTest test = withNtfServer (transport @c) $ testNtfClient test
+
+ntfServerTest ::
+  forall c smp.
+  (Transport c, Encoding smp) =>
+  TProxy c ->
+  (Maybe C.ASignature, ByteString, ByteString, smp) ->
+  IO (Maybe C.ASignature, ByteString, ByteString, BrokerMsg)
+ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
+  where
+    tPut' h (sig, corrId, queueId, smp) = do
+      let t' = smpEncode (sessionId (h :: THandle c), corrId, queueId, smp)
+      Right () <- tPut h (sig, t')
+      pure ()
+    tGet' h = do
+      (Nothing, _, (CorrId corrId, qId, Right cmd)) <- tGet h
+      pure (Nothing, corrId, qId, cmd)
\ No newline at end of file
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
new file mode 100644
index 000000000..93195e8ac
--- /dev/null
+++ b/tests/NtfServerTests.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module NtfServerTests where
+
+import Data.ByteString.Char8 (ByteString)
+import NtfClient
+import ServerTests (sampleDhPubKey, samplePubKey, sampleSig)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Protocol
+import Simplex.Messaging.Transport
+import Test.Hspec
+
+ntfServerTests :: ATransport -> Spec
+ntfServerTests t = do
+  describe "notifications server protocol syntax" $ ntfSyntaxTests t
+
+ntfSyntaxTests :: ATransport -> Spec
+ntfSyntaxTests (ATransport t) = do
+  it "unknown command" $ ("", "abcd", "1234", ('H', 'E', 'L', 'L', 'O')) >#> ("", "abcd", "1234", ERR $ CMD UNKNOWN)
+  describe "NEW" $ do
+    it "no parameters" $ (sampleSig, "bcda", "", TNEW_) >#> ("", "bcda", "", ERR $ CMD SYNTAX)
+    it "many parameters" $ (sampleSig, "cdab", "", (TNEW_, (' ', '\x01', 'A'), ('T', 'A', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "cdab", "", ERR $ CMD SYNTAX)
+    it "no signature" $ ("", "dabc", "", (TNEW_, ' ', ('T', 'A', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
+    it "token ID" $ (sampleSig, "abcd", "12345678", (TNEW_, ' ', ('T', 'A', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "abcd", "12345678", ERR $ CMD HAS_AUTH)
+  where
+    (>#>) ::
+      Encoding smp =>
+      (Maybe C.ASignature, ByteString, ByteString, smp) ->
+      (Maybe C.ASignature, ByteString, ByteString, BrokerMsg) ->
+      Expectation
+    command >#> response = ntfServerTest t command `shouldReturn` response
\ No newline at end of file
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index e232ffdbd..304ba9674 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -154,11 +154,17 @@ smpAgentTest1_1_1 test' =
     _test [h] = test' h
     _test _ = error "expected 1 handle"
 
+initAgentServers :: InitialAgentServers
+initAgentServers =
+  InitialAgentServers
+    { smp = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
+      ntf = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"]
+    }
+
 cfg :: AgentConfig
 cfg =
   defaultAgentConfig
     { tcpPort = agentTestPort,
-      initialSMPServers = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
       tbqSize = 1,
       dbFile = testDB,
       smpCfg =
@@ -167,7 +173,7 @@ cfg =
             defaultTransport = (testPort, transport @TLS),
             tcpTimeout = 500_000
           },
-      reconnectInterval = (reconnectInterval defaultAgentConfig) {initialInterval = 50_000},
+      reconnectInterval = defaultReconnectInterval {initialInterval = 50_000},
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
       certificateFile = "tests/fixtures/server.crt"
@@ -175,9 +181,10 @@ cfg =
 
 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
 withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
-  let cfg' = cfg {tcpPort = port', dbFile = db', initialSMPServers = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
+  let cfg' = cfg {tcpPort = port', dbFile = db'}
+      initServers' = initAgentServers {smp = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
    in serverBracket
-        (\started -> runSMPAgentBlocking t started cfg')
+        (\started -> runSMPAgentBlocking t started cfg' initServers')
         afterProcess
 
 withSmpAgentThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> (ThreadId -> m a) -> m a
diff --git a/tests/Test.hs b/tests/Test.hs
index 03eab361d..bdd67c0dc 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -4,6 +4,7 @@ import AgentTests (agentTests)
 import CoreTests.EncodingTests
 import CoreTests.ProtocolErrorTests
 import CoreTests.VersionRangeTests
+import NtfServerTests (ntfServerTests)
 import ServerTests
 import Simplex.Messaging.Transport (TLS, Transport (..))
 import Simplex.Messaging.Transport.WebSockets (WS)
@@ -20,5 +21,6 @@ main = do
       describe "Version range" versionRangeTests
     describe "SMP server via TLS" $ serverTests (transport @TLS)
     describe "SMP server via WebSockets" $ serverTests (transport @WS)
+    describe "Ntf server via TLS" $ ntfServerTests (transport @TLS)
     describe "SMP client agent" $ agentTests (transport @TLS)
   removeDirectoryRecursive "tests/tmp"

From 45ddecc4b8d7592eb79650288401e163536b1c2f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 14 Apr 2022 11:33:17 +0100
Subject: [PATCH 06/12] APNS/HTTP2 push client for notifications server (#350)

* APN push client (WIP)

* APNS push client works

* TODO comments

* comment

* send notification and process the response

* config

* e2e encryption for notification parameter

* read apns key filename and ID from env

* connect APNS client to server, fix notification JSON encoding to use dash case

* do not connect to APNS on start to pass CI tests

* fix CI test

* remove redundant import
---
 apps/ntf-server/Main.hs                       |   2 +
 package.yaml                                  |   3 +
 simplexmq.cabal                               | 250 +++++++------
 src/Simplex/Messaging/Agent/Store.hs          |   4 +-
 src/Simplex/Messaging/Client.hs               |   2 +-
 src/Simplex/Messaging/Crypto.hs               |  17 +-
 src/Simplex/Messaging/Notifications/Server.hs |  61 +--
 .../Messaging/Notifications/Server/Env.hs     |  50 +--
 .../Messaging/Notifications/Server/Push.hs    |  11 -
 .../Notifications/Server/Push/.gitignore      |   1 +
 .../Notifications/Server/Push/APNS.hs         | 348 ++++++++++++++++++
 .../Notifications/Server/Push/testpush.sh     |  20 +
 .../Notifications/Server/Subscriptions.hs     |   8 -
 src/Simplex/Messaging/Server.hs               |  11 +-
 src/Simplex/Messaging/Transport/Client.hs     |  23 +-
 .../Messaging/Transport/Client/HTTP2.hs       | 169 +++++++++
 src/Simplex/Messaging/Transport/KeepAlive.hs  |   1 +
 tests/NtfClient.hs                            |   4 +-
 tests/NtfServerTests.hs                       |   6 +-
 tests/SMPAgentClient.hs                       |   2 +-
 tests/SMPClient.hs                            |   2 +-
 21 files changed, 791 insertions(+), 204 deletions(-)
 delete mode 100644 src/Simplex/Messaging/Notifications/Server/Push.hs
 create mode 100644 src/Simplex/Messaging/Notifications/Server/Push/.gitignore
 create mode 100644 src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
 create mode 100755 src/Simplex/Messaging/Notifications/Server/Push/testpush.sh
 create mode 100644 src/Simplex/Messaging/Transport/Client/HTTP2.hs

diff --git a/apps/ntf-server/Main.hs b/apps/ntf-server/Main.hs
index 928b9e514..478077e25 100644
--- a/apps/ntf-server/Main.hs
+++ b/apps/ntf-server/Main.hs
@@ -5,6 +5,7 @@ module Main where
 import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
 import Simplex.Messaging.Notifications.Server (runNtfServer)
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
+import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
 import Simplex.Messaging.Server.CLI (ServerCLIConfig (..), protocolServerCLI)
 import System.FilePath (combine)
 
@@ -44,6 +45,7 @@ ntfServerCLIConfig =
                 subQSize = 64,
                 pushQSize = 128,
                 smpAgentCfg = defaultSMPClientAgentConfig,
+                apnsConfig = defaultAPNSPushClientConfig,
                 caCertificateFile = caCrtFile,
                 privateKeyFile = serverKeyFile,
                 certificateFile = serverCrtFile
diff --git a/package.yaml b/package.yaml
index 7b804a55f..61e000158 100644
--- a/package.yaml
+++ b/package.yaml
@@ -31,6 +31,7 @@ dependencies:
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3
   - bytestring == 0.10.*
+  - case-insensitive == 1.2.*
   - composition == 1.0.*
   - constraints >= 0.12 && < 0.14
   - containers == 0.6.*
@@ -41,6 +42,7 @@ dependencies:
   - directory == 1.3.*
   - filepath == 1.4.*
   - http-types == 0.12.*
+  - http2 == 3.0.*
   - generic-random >= 1.3 && < 1.5
   - ini == 0.4.*
   - iso8601-time == 0.1.*
@@ -58,6 +60,7 @@ dependencies:
   - template-haskell == 2.16.*
   - text == 1.2.*
   - time == 1.9.*
+  - time-manager == 0.0.*
   - tls >= 1.5.7 && < 1.6
   - transformers == 0.5.*
   - unliftio == 0.2.*
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 61c2001ad..6a64f8214 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -47,6 +47,7 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220404_ntf_subscriptions_draft
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
       Simplex.Messaging.Crypto
@@ -57,6 +58,7 @@ library
       Simplex.Messaging.Notifications.Protocol
       Simplex.Messaging.Notifications.Server
       Simplex.Messaging.Notifications.Server.Env
+      Simplex.Messaging.Notifications.Server.Push.APNS
       Simplex.Messaging.Notifications.Server.Subscriptions
       Simplex.Messaging.Notifications.Transport
       Simplex.Messaging.Parsers
@@ -72,6 +74,7 @@ library
       Simplex.Messaging.TMap
       Simplex.Messaging.Transport
       Simplex.Messaging.Transport.Client
+      Simplex.Messaging.Transport.Client.HTTP2
       Simplex.Messaging.Transport.KeepAlive
       Simplex.Messaging.Transport.Server
       Simplex.Messaging.Transport.WebSockets
@@ -93,6 +96,7 @@ library
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
+    , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
@@ -104,6 +108,7 @@ library
     , filepath ==1.4.*
     , generic-random >=1.3 && <1.5
     , http-types ==0.12.*
+    , http2 ==3.0.*
     , ini ==0.4.*
     , iso8601-time ==0.1.*
     , memory ==0.15.*
@@ -119,117 +124,7 @@ library
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
-    , tls >=1.5.7 && <1.6
-    , transformers ==0.5.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
-    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
-  if flag(swift)
-    ghc-options: -DswiftJSON
-  default-language: Haskell2010
-
-executable smp-agent
-  main-is: Main.hs
-  other-modules:
-      Paths_simplexmq
-  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.14.*
-    , aeson ==2.0.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.7 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.10.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , cryptonite >=0.27 && <0.30
-    , cryptostore ==0.2.*
-    , data-default ==0.7.*
-    , direct-sqlite ==2.3.*
-    , directory ==1.3.*
-    , filepath ==1.4.*
-    , generic-random >=1.3 && <1.5
-    , http-types ==0.12.*
-    , iso8601-time ==0.1.*
-    , memory ==0.15.*
-    , mtl ==2.2.*
-    , network ==3.1.2.*
-    , network-transport ==0.5.*
-    , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
-    , simplexmq
-    , sqlite-simple ==0.4.*
-    , stm ==2.5.*
-    , template-haskell ==2.16.*
-    , text ==1.2.*
-    , time ==1.9.*
-    , tls >=1.5.7 && <1.6
-    , transformers ==0.5.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
-    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
-  if flag(swift)
-    ghc-options: -DswiftJSON
-  default-language: Haskell2010
-
-executable smp-server
-  main-is: Main.hs
-  other-modules:
-      Paths_simplexmq
-  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.14.*
-    , aeson ==2.0.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.7 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.10.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , cryptonite >=0.27 && <0.30
-    , cryptostore ==0.2.*
-    , data-default ==0.7.*
-    , direct-sqlite ==2.3.*
-    , directory ==1.3.*
-    , filepath ==1.4.*
-    , generic-random >=1.3 && <1.5
-    , http-types ==0.12.*
-    , ini ==0.4.*
-    , iso8601-time ==0.1.*
-    , memory ==0.15.*
-    , mtl ==2.2.*
-    , network ==3.1.2.*
-    , network-transport ==0.5.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
-    , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
-    , simplexmq
-    , sqlite-simple ==0.4.*
-    , stm ==2.5.*
-    , template-haskell ==2.16.*
-    , text ==1.2.*
-    , time ==1.9.*
+    , time-manager ==0.0.*
     , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
@@ -260,6 +155,7 @@ executable ntf-server
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
+    , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
@@ -271,6 +167,7 @@ executable ntf-server
     , filepath ==1.4.*
     , generic-random >=1.3 && <1.5
     , http-types ==0.12.*
+    , http2 ==3.0.*
     , ini ==0.4.*
     , iso8601-time ==0.1.*
     , memory ==0.15.*
@@ -287,6 +184,7 @@ executable ntf-server
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
+    , time-manager ==0.0.*
     , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
     , unliftio ==0.2.*
@@ -295,6 +193,128 @@ executable ntf-server
     , x509 ==1.7.*
     , x509-store ==1.6.*
     , x509-validation ==1.6.*
+  if flag(swift)
+    ghc-options: -DswiftJSON
+  default-language: Haskell2010
+
+executable smp-agent
+  main-is: Main.hs
+  other-modules:
+      Paths_simplexmq
+  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.14.*
+    , aeson ==2.0.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , case-insensitive ==1.2.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
+    , data-default ==0.7.*
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , http-types ==0.12.*
+    , http2 ==3.0.*
+    , ini ==0.4.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.2.*
+    , network-transport ==0.5.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , time-manager ==0.0.*
+    , tls >=1.5.7 && <1.6
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
+  if flag(swift)
+    ghc-options: -DswiftJSON
+  default-language: Haskell2010
+
+executable smp-server
+  main-is: Main.hs
+  other-modules:
+      Paths_simplexmq
+  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.14.*
+    , aeson ==2.0.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , case-insensitive ==1.2.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
+    , data-default ==0.7.*
+    , direct-sqlite ==2.3.*
+    , directory ==1.3.*
+    , filepath ==1.4.*
+    , generic-random >=1.3 && <1.5
+    , http-types ==0.12.*
+    , http2 ==3.0.*
+    , ini ==0.4.*
+    , iso8601-time ==0.1.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network ==3.1.2.*
+    , network-transport ==0.5.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
+    , simplexmq
+    , sqlite-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , time-manager ==0.0.*
+    , tls >=1.5.7 && <1.6
+    , transformers ==0.5.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
+  if flag(swift)
+    ghc-options: -DswiftJSON
   default-language: Haskell2010
 
 test-suite smp-server-test
@@ -309,7 +329,7 @@ test-suite smp-server-test
       CoreTests.EncodingTests
       CoreTests.ProtocolErrorTests
       CoreTests.VersionRangeTests
-      NtfClient,
+      NtfClient
       NtfServerTests
       ServerTests
       SMPAgentClient
@@ -330,6 +350,7 @@ test-suite smp-server-test
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
     , bytestring ==0.10.*
+    , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
@@ -343,11 +364,15 @@ test-suite smp-server-test
     , hspec ==2.7.*
     , hspec-core ==2.7.*
     , http-types ==0.12.*
+    , http2 ==3.0.*
+    , ini ==0.4.*
     , iso8601-time ==0.1.*
     , memory ==0.15.*
     , mtl ==2.2.*
     , network ==3.1.2.*
     , network-transport ==0.5.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
     , random >=1.1 && <1.3
     , simple-logger ==0.1.*
     , simplexmq
@@ -356,6 +381,7 @@ test-suite smp-server-test
     , template-haskell ==2.16.*
     , text ==1.2.*
     , time ==1.9.*
+    , time-manager ==0.0.*
     , timeit ==2.0.*
     , tls >=1.5.7 && <1.6
     , transformers ==0.5.*
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index efcd87d3c..5a2c246ac 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -79,7 +79,9 @@ class Monad m => MonadAgentStore s m where
 
   -- Notification device token persistence
   createNtfToken :: s -> NtfToken -> m ()
-  getDeviceNtfToken :: s -> DeviceToken -> m (Maybe NtfToken) -- return current token if it exists and mark any old tokens for deletion
+
+  -- TODO this should also return old tokens so that they are deleted from the server
+  getDeviceNtfToken :: s -> DeviceToken -> m (Maybe NtfToken) -- return current token if it exists
   updateNtfTokenRegistration :: s -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> m ()
   updateNtfToken :: s -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> m ()
 
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 8ff256e6d..dbe47d5f6 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -161,7 +161,7 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
       thVar <- newEmptyTMVarIO
       action <-
         async $
-          runTransportClient (host protocolServer) port' (keyHash protocolServer) tcpKeepAlive (client t c thVar)
+          runTransportClient (host protocolServer) port' (Just $ keyHash protocolServer) tcpKeepAlive (client t c thVar)
             `finally` atomically (putTMVar thVar $ Left PCENetworkError)
       th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar)
       pure $ case th_ of
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 92ff4f75e..9f275e805 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -103,6 +103,10 @@ module Simplex.Messaging.Crypto
     cbDecrypt,
     cbNonce,
     randomCbNonce,
+    pseudoRandomCbNonce,
+
+    -- * pseudo-random bytes
+    pseudoRandomBytes,
 
     -- * SHA256 hash
     sha256Hash,
@@ -116,6 +120,7 @@ module Simplex.Messaging.Crypto
   )
 where
 
+import Control.Concurrent.STM
 import Control.Exception (Exception)
 import Control.Monad.Except
 import Control.Monad.Trans.Except
@@ -129,7 +134,7 @@ import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
 import qualified Crypto.PubKey.Ed25519 as Ed25519
 import qualified Crypto.PubKey.Ed448 as Ed448
-import Crypto.Random (getRandomBytes)
+import Crypto.Random (ChaChaDRG, getRandomBytes, randomBytesGenerate)
 import Data.ASN1.BinaryEncoding
 import Data.ASN1.Encoding
 import Data.ASN1.Types
@@ -876,6 +881,16 @@ cbNonce s
 randomCbNonce :: IO CbNonce
 randomCbNonce = CbNonce <$> getRandomBytes 24
 
+pseudoRandomCbNonce :: TVar ChaChaDRG -> STM CbNonce
+pseudoRandomCbNonce gVar = CbNonce <$> pseudoRandomBytes 24 gVar
+
+pseudoRandomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
+pseudoRandomBytes n gVar = do
+  g <- readTVar gVar
+  let (bytes, g') = randomBytesGenerate n g
+  writeTVar gVar g'
+  return bytes
+
 instance Encoding CbNonce where
   smpEncode = unCbNonce
   smpP = CbNonce <$> A.take 24
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 64312e717..942b2db42 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -14,13 +14,13 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
-import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import Network.Socket (ServiceName)
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Env
+import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Subscriptions
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol (ErrorType (..), SignedTransmission, Transmission, encodeTransmission, tGet, tPut)
@@ -60,7 +60,7 @@ runNtfServerBlocking started cfg@NtfServerConfig {transports} = do
         Right th -> runNtfClientTransport th
         Left _ -> pure ()
 
-ntfSubscriber :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfSubscriber -> m ()
+ntfSubscriber :: forall m. MonadUnliftIO m => NtfSubscriber -> m ()
 ntfSubscriber NtfSubscriber {subQ, smpAgent = ca@SMPClientAgent {msgQ, agentQ}} = do
   raceAny_ [subscribe, receiveSMP, receiveAgent]
   where
@@ -71,11 +71,11 @@ ntfSubscriber NtfSubscriber {subQ, smpAgent = ca@SMPClientAgent {msgQ, agentQ}}
           let SMPQueueNtf {smpServer, notifierId, notifierKey} = smpQueue
           liftIO (runExceptT $ subscribeQueue ca smpServer ((SPNotifier, notifierId), notifierKey)) >>= \case
             Right _ -> pure () -- update subscription status
-            Left e -> pure ()
+            Left _e -> pure ()
 
     receiveSMP :: m ()
     receiveSMP = forever $ do
-      (srv, sessId, ntfId, msg) <- atomically $ readTBQueue msgQ
+      (_srv, _sessId, _ntfId, msg) <- atomically $ readTBQueue msgQ
       case msg of
         SMP.NMSG -> do
           -- check when the last NMSG was received from this queue
@@ -92,26 +92,37 @@ ntfSubscriber NtfSubscriber {subQ, smpAgent = ca@SMPClientAgent {msgQ, agentQ}}
       forever $
         atomically (readTBQueue agentQ) >>= \case
           CAConnected _ -> pure ()
-          CADisconnected srv subs -> do
+          CADisconnected _srv _subs -> do
             -- update subscription statuses
             pure ()
           CAReconnected _ -> pure ()
-          CAResubscribed srv sub -> do
+          CAResubscribed _srv _sub -> do
             -- update subscription status
             pure ()
-          CASubError srv sub err -> do
+          CASubError _srv _sub _err -> do
             -- update subscription status
             pure ()
 
-ntfPush :: (MonadUnliftIO m, MonadReader NtfEnv m) => NtfPushServer -> m ()
-ntfPush NtfPushServer {pushQ} = forever $ do
-  atomically (readTBQueue pushQ) >>= \case
-    (NtfTknData {tknStatus}, notification) -> do
-      liftIO $ print $ J.encode notification
-      -- TODO status update should happen after the token status successfully sent
-      case notification of
-        PNVerification _ -> atomically $ writeTVar tknStatus NTConfirmed
-        _ -> pure ()
+ntfPush :: MonadUnliftIO m => NtfPushServer -> m ()
+ntfPush s@NtfPushServer {pushQ} = liftIO . forever . runExceptT $ do
+  (tkn@NtfTknData {token = DeviceToken pp _, tknStatus}, ntf) <- atomically (readTBQueue pushQ)
+  liftIO $ putStrLn $ "sending push notification to " <> show pp
+  status <- readTVarIO tknStatus
+  case (status, ntf) of
+    (_, PNVerification _) -> do
+      -- TODO check token status
+      deliverNotification pp tkn ntf
+      atomically $ writeTVar tknStatus NTConfirmed
+    (NTActive, PNCheckMessages) -> do
+      deliverNotification pp tkn ntf
+    _ -> do
+      liftIO $ putStrLn "bad notification token status"
+  where
+    deliverNotification :: PushProvider -> PushProviderClient
+    deliverNotification pp tkn ntf = do
+      deliver <- liftIO $ getPushClient s pp
+      -- TODO retry later based on the error
+      deliver tkn ntf `catchError` \e -> liftIO (putStrLn $ "Push provider error (" <> show pp <> "): " <> show e) >> throwError e
 
 runNtfClientTransport :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> m ()
 runNtfClientTransport th@THandle {sessionId} = do
@@ -128,6 +139,7 @@ clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connecte
 receive :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> NtfServerClient -> m ()
 receive th NtfServerClient {rcvQ, sndQ} = forever $ do
   t@(_, _, (corrId, subId, cmdOrError)) <- tGet th
+  liftIO $ putStrLn "receive"
   case cmdOrError of
     Left e -> write sndQ (corrId, subId, NRErr e)
     Right cmd ->
@@ -181,7 +193,7 @@ verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do
 --       _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` VRFail
 
 client :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfServerClient -> NtfSubscriber -> NtfPushServer -> m ()
-client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ} NtfPushServer {pushQ} =
+client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {pushQ} =
   forever $
     atomically (readTBQueue rcvQ)
       >>= processCommand
@@ -190,6 +202,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ} NtfPushServer {pushQ} =
     processCommand :: NtfRequest -> m (Transmission NtfResponse)
     processCommand = \case
       NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn _ _ dhPubKey)) -> do
+        liftIO $ putStrLn "TNEW"
         st <- asks store
         (srvDhPubKey, srvDrivDhKey) <- liftIO C.generateKeyPair'
         let dhSecret = C.dh' dhPubKey srvDrivDhKey
@@ -203,18 +216,20 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ} NtfPushServer {pushQ} =
       NtfReqCmd SToken (NtfTkn NtfTknData {tknStatus, tknRegCode}) (corrId, tknId, cmd) -> do
         status <- readTVarIO tknStatus
         (corrId,tknId,) <$> case cmd of
-          TNEW newTkn -> pure NROk -- TODO when duplicate token sent
+          TNEW _newTkn -> do
+            liftIO $ putStrLn "TNEW'"
+            pure NROk -- TODO when duplicate token sent
           TVFY code -- this allows repeated verification for cases when client connection dropped before server response
             | (status == NTRegistered || status == NTConfirmed || status == NTActive) && tknRegCode == code -> do
               atomically $ writeTVar tknStatus NTActive
               pure NROk
             | otherwise -> pure $ NRErr AUTH
           TDEL -> pure NROk
-          TCRN int -> pure NROk
-      NtfReqNew corrId (ANE SSubscription newSub) -> pure (corrId, "", NROk)
-      NtfReqCmd SSubscription sub (corrId, subId, cmd) ->
+          TCRN _int -> pure NROk
+      NtfReqNew corrId (ANE SSubscription _newSub) -> pure (corrId, "", NROk)
+      NtfReqCmd SSubscription _sub (corrId, subId, cmd) ->
         (corrId,subId,) <$> case cmd of
-          SNEW newSub -> pure NROk
+          SNEW _newSub -> pure NROk
           SCHK -> pure NROk
           SDEL -> pure NROk
           PING -> pure NRPong
@@ -225,7 +240,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ} NtfPushServer {pushQ} =
     getRandomBytes :: Int -> m ByteString
     getRandomBytes n = do
       gVar <- asks idsDrg
-      atomically (randomBytes n gVar)
+      atomically (C.pseudoRandomBytes n gVar)
 
 -- NReqCreate corrId tokenId smpQueue -> pure (corrId, "", NROk)
 -- do
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index e76c63375..67b83f1af 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -1,28 +1,27 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Messaging.Notifications.Server.Env where
 
 import Control.Monad.IO.Unlift
 import Crypto.Random
-import Data.Aeson (FromJSON, ToJSON)
-import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import Data.X509.Validation (Fingerprint (..))
-import GHC.Generics
 import Network.Socket
 import qualified Network.TLS as T
 import Numeric.Natural
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Subscriptions
-import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
 import Simplex.Messaging.Protocol (CorrId, Transmission)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport)
 import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams)
 import UnliftIO.STM
@@ -35,22 +34,13 @@ data NtfServerConfig = NtfServerConfig
     subQSize :: Natural,
     pushQSize :: Natural,
     smpAgentCfg :: SMPClientAgentConfig,
+    apnsConfig :: APNSPushClientConfig,
     -- CA certificate private key is not needed for initialization
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
     certificateFile :: FilePath
   }
 
-data PushNotification = PNVerification {code :: NtfRegCode} | PNPeriodic
-  deriving (Show, Generic)
-
-instance FromJSON PushNotification where
-  parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "PN"
-
-instance ToJSON PushNotification where
-  toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "PN"
-  toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "PN"
-
 data NtfEnv = NtfEnv
   { config :: NtfServerConfig,
     subscriber :: NtfSubscriber,
@@ -63,11 +53,13 @@ data NtfEnv = NtfEnv
   }
 
 newNtfServerEnv :: (MonadUnliftIO m, MonadRandom m) => NtfServerConfig -> m NtfEnv
-newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, caCertificateFile, certificateFile, privateKeyFile} = do
+newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, caCertificateFile, certificateFile, privateKeyFile} = do
   idsDrg <- newTVarIO =<< drgNew
   store <- atomically newNtfStore
   subscriber <- atomically $ newNtfSubscriber subQSize smpAgentCfg
-  pushServer <- atomically $ newNtfPushServer pushQSize
+  pushServer <- atomically $ newNtfPushServer pushQSize apnsConfig
+  -- TODO not creating APNS client on start to pass CI test, has to be replaced with mock APNS server
+  -- void . liftIO $ newPushClient pushServer PPApple
   tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
   Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
   pure NtfEnv {config, subscriber, pushServer, store, idsDrg, tlsServerParams, serverIdentity = C.KeyHash fp}
@@ -83,14 +75,28 @@ newNtfSubscriber qSize smpAgentCfg = do
   subQ <- newTBQueue qSize
   pure NtfSubscriber {smpAgent, subQ}
 
-newtype NtfPushServer = NtfPushServer
-  { pushQ :: TBQueue (NtfTknData, PushNotification)
+data NtfPushServer = NtfPushServer
+  { pushQ :: TBQueue (NtfTknData, PushNotification),
+    pushClients :: TMap PushProvider PushProviderClient,
+    apnsConfig :: APNSPushClientConfig
   }
 
-newNtfPushServer :: Natural -> STM NtfPushServer
-newNtfPushServer qSize = do
+newNtfPushServer :: Natural -> APNSPushClientConfig -> STM NtfPushServer
+newNtfPushServer qSize apnsConfig = do
   pushQ <- newTBQueue qSize
-  pure NtfPushServer {pushQ}
+  pushClients <- TM.empty
+  pure NtfPushServer {pushQ, pushClients, apnsConfig}
+
+newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
+newPushClient NtfPushServer {apnsConfig, pushClients} = \case
+  PPApple -> do
+    c <- apnsPushProviderClient <$> createAPNSPushClient apnsConfig
+    atomically $ TM.insert PPApple c pushClients
+    pure c
+
+getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
+getPushClient s@NtfPushServer {pushClients} pp =
+  atomically (TM.lookup pp pushClients) >>= maybe (newPushClient s pp) pure
 
 data NtfRequest
   = NtfReqNew CorrId ANewNtfEntity
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
deleted file mode 100644
index 87b475f2a..000000000
--- a/src/Simplex/Messaging/Notifications/Server/Push.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Simplex.Messaging.Notifications.Server.Push where
-
-import Control.Concurrent.STM
-import Data.ByteString.Char8 (ByteString)
-import Simplex.Messaging.Protocol (NotifierId, SMPServer)
-
-data NtfPushPayload = NPVerification ByteString | NPNotification SMPServer NotifierId | NPPing
-
-class PushProvider p where
-  newPushProvider :: STM p
-  requestBody :: p -> NtfPushPayload -> ByteString -- ?
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/.gitignore b/src/Simplex/Messaging/Notifications/Server/Push/.gitignore
new file mode 100644
index 000000000..61d5e2e09
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Push/.gitignore
@@ -0,0 +1 @@
+local.env
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
new file mode 100644
index 000000000..8a67f9fcf
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -0,0 +1,348 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Notifications.Server.Push.APNS where
+
+import Control.Monad.Except
+import Crypto.Hash.Algorithms (SHA256 (..))
+import qualified Crypto.PubKey.ECC.ECDSA as EC
+import qualified Crypto.PubKey.ECC.Types as ECT
+import Crypto.Random (ChaChaDRG, drgNew)
+import qualified Crypto.Store.PKCS8 as PK
+import Data.ASN1.BinaryEncoding (DER (..))
+import Data.ASN1.Encoding
+import Data.ASN1.Types
+import Data.Aeson (FromJSON, ToJSON, (.=))
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Encoding as JE
+import Data.Bifunctor (first)
+import qualified Data.ByteString.Base64.URL as U
+import Data.ByteString.Builder (lazyByteString)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.CaseInsensitive as CI
+import Data.Int (Int64)
+import Data.Map.Strict (Map)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8With)
+import Data.Time.Clock.System
+import qualified Data.X509 as X
+import GHC.Generics
+import Network.HTTP.Types (HeaderName, Status, hAuthorization, methodPost)
+import qualified Network.HTTP.Types as N
+import Network.HTTP2.Client (Request)
+import qualified Network.HTTP2.Client as H
+import Network.Socket (HostName, ServiceName)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Subscriptions (NtfTknData (..))
+import Simplex.Messaging.Protocol (NotifierId, SMPServer)
+import Simplex.Messaging.Transport.Client.HTTP2
+import System.Environment (getEnv)
+import UnliftIO.STM
+
+data JWTHeader = JWTHeader
+  { alg :: Text, -- key algorithm, ES256 for APNS
+    kid :: Text -- key ID
+  }
+  deriving (Show, Generic)
+
+instance ToJSON JWTHeader where toEncoding = J.genericToEncoding J.defaultOptions
+
+data JWTClaims = JWTClaims
+  { iss :: Text, -- issuer, team ID for APNS
+    iat :: Int64 -- issue time, seconds from epoch
+  }
+  deriving (Show, Generic)
+
+instance ToJSON JWTClaims where toEncoding = J.genericToEncoding J.defaultOptions
+
+data JWTToken = JWTToken JWTHeader JWTClaims
+  deriving (Show)
+
+mkJWTToken :: JWTHeader -> Text -> IO JWTToken
+mkJWTToken hdr iss = do
+  iat <- systemSeconds <$> getSystemTime
+  pure $ JWTToken hdr JWTClaims {iss, iat}
+
+type SignedJWTToken = ByteString
+
+signedJWTToken :: EC.PrivateKey -> JWTToken -> IO SignedJWTToken
+signedJWTToken pk (JWTToken hdr claims) = do
+  let hc = jwtEncode hdr <> "." <> jwtEncode claims
+  sig <- EC.sign pk SHA256 hc
+  pure $ hc <> "." <> serialize sig
+  where
+    jwtEncode :: ToJSON a => a -> ByteString
+    jwtEncode = U.encodeUnpadded . LB.toStrict . J.encode
+    serialize sig = U.encodeUnpadded $ encodeASN1' DER [Start Sequence, IntVal (EC.sign_r sig), IntVal (EC.sign_s sig), End Sequence]
+
+readECPrivateKey :: FilePath -> IO EC.PrivateKey
+readECPrivateKey f = do
+  -- TODO this is specific to APNS key
+  [PK.Unprotected (X.PrivKeyEC X.PrivKeyEC_Named {privkeyEC_name, privkeyEC_priv})] <- PK.readKeyFile f
+  pure EC.PrivateKey {private_curve = ECT.getCurveByName privkeyEC_name, private_d = privkeyEC_priv}
+
+data PushNotification
+  = PNVerification NtfRegCode
+  | PNMessage SMPServer NotifierId
+  | PNAlert Text
+  | PNCheckMessages
+
+data APNSNotification = APNSNotification {aps :: APNSNotificationBody, notificationData :: Maybe J.Value}
+  deriving (Show, Generic)
+
+instance ToJSON APNSNotification where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+data APNSNotificationBody
+  = APNSAlert {alert :: APNSAlertBody, badge :: Maybe Int, sound :: Maybe Text, category :: Maybe Text}
+  | APNSBackground {contentAvailable :: Int}
+  | APNSMutableContent {mutableContent :: Int, alert :: APNSAlertBody, category :: Maybe Text}
+  deriving (Show, Generic)
+
+apnsJSONOptions :: J.Options
+apnsJSONOptions = J.defaultOptions {J.omitNothingFields = True, J.sumEncoding = J.UntaggedValue, J.fieldLabelModifier = J.camelTo2 '-'}
+
+instance ToJSON APNSNotificationBody where
+  toJSON = J.genericToJSON apnsJSONOptions
+  toEncoding = J.genericToEncoding apnsJSONOptions
+
+type APNSNotificationData = Map Text Text
+
+data APNSAlertBody = APNSAlertObject {title :: Text, subtitle :: Text, body :: Text} | APNSAlertText Text
+  deriving (Show)
+
+instance ToJSON APNSAlertBody where
+  toEncoding = \case
+    APNSAlertObject {title, subtitle, body} -> J.pairs $ "title" .= title <> "subtitle" .= subtitle <> "body" .= body
+    APNSAlertText t -> JE.text t
+  toJSON = \case
+    APNSAlertObject {title, subtitle, body} -> J.object ["title" .= title, "subtitle" .= subtitle, "body" .= body]
+    APNSAlertText t -> J.String t
+
+-- APNS notification types
+--
+-- Visible alerts:
+-- {
+--    "aps" : {
+--       "alert" : {
+--          "title" : "Game Request",
+--          "subtitle" : "Five Card Draw",
+--          "body" : "Bob wants to play poker"
+--       },
+--       "badge" : 9,
+--       "sound" : "bingbong.aiff",
+--       "category" : "GAME_INVITATION"
+--    },
+--    "gameID" : "12345678"
+-- }
+--
+-- Simple text alert:
+-- {"aps":{"alert":"you have a new message"}}
+--
+-- Background notification to fetch content
+-- {"aps":{"content-available":1}}
+--
+-- Mutable content notification that must be shown but can be processed before before being shown (up to 30 sec)
+-- {
+--    "aps" : {
+--       "category" : "SECRET",
+--       "mutable-content" : 1,
+--       "alert" : {
+--          "title" : "Secret Message!",
+--          "body"  : "(Encrypted)"
+--      },
+--    },
+--    "ENCRYPTED_DATA" : "Salted__·öîQÊ$UDì_¶Ù∞èΩ^¬%gq∞NÿÒQùw"
+-- }
+
+data APNSPushClientConfig = APNSPushClientConfig
+  { tokenTTL :: Int64,
+    authKeyFileEnv :: String,
+    authKeyAlg :: Text,
+    authKeyIdEnv :: String,
+    paddedNtfLength :: Int,
+    appName :: ByteString,
+    appTeamId :: Text,
+    apnHost :: HostName,
+    apnPort :: ServiceName,
+    https2cfg :: HTTP2SClientConfig
+  }
+  deriving (Show)
+
+defaultAPNSPushClientConfig :: APNSPushClientConfig
+defaultAPNSPushClientConfig =
+  APNSPushClientConfig
+    { tokenTTL = 1200, -- 20 minutes
+      authKeyFileEnv = "APNS_KEY_FILE", -- the environment variables APNS_KEY_FILE and APNS_KEY_ID must be set, or the server would fail to start
+      authKeyAlg = "ES256",
+      authKeyIdEnv = "APNS_KEY_ID",
+      paddedNtfLength = 256,
+      appName = "chat.simplex.app",
+      appTeamId = "5NN7GUYB6T",
+      apnHost = "api.sandbox.push.apple.com",
+      apnPort = "443",
+      https2cfg = defaultHTTP2SClientConfig
+    }
+
+data APNSPushClient = APNSPushClient
+  { https2Client :: TVar (Maybe HTTPS2Client),
+    privateKey :: EC.PrivateKey,
+    jwtHeader :: JWTHeader,
+    jwtToken :: TVar (JWTToken, SignedJWTToken),
+    nonceDrg :: TVar ChaChaDRG,
+    apnsCfg :: APNSPushClientConfig
+  }
+
+createAPNSPushClient :: APNSPushClientConfig -> IO APNSPushClient
+createAPNSPushClient apnsCfg@APNSPushClientConfig {authKeyFileEnv, authKeyAlg, authKeyIdEnv, appTeamId} = do
+  https2Client <- newTVarIO Nothing
+  void $ connectHTTPS2 apnsCfg https2Client
+  privateKey <- readECPrivateKey =<< getEnv authKeyFileEnv
+  authKeyId <- T.pack <$> getEnv authKeyIdEnv
+  putStrLn $ authKeyIdEnv <> "=" <> T.unpack authKeyId
+  let jwtHeader = JWTHeader {alg = authKeyAlg, kid = authKeyId}
+  jwtToken <- newTVarIO =<< mkApnsJWTToken appTeamId jwtHeader privateKey
+  nonceDrg <- drgNew >>= newTVarIO
+  pure APNSPushClient {https2Client, privateKey, jwtHeader, jwtToken, nonceDrg, apnsCfg}
+
+getApnsJWTToken :: APNSPushClient -> IO SignedJWTToken
+getApnsJWTToken APNSPushClient {apnsCfg = APNSPushClientConfig {appTeamId, tokenTTL}, privateKey, jwtHeader, jwtToken} = do
+  (jwt, signedJWT) <- readTVarIO jwtToken
+  age <- jwtTokenAge jwt
+  if age < tokenTTL
+    then pure signedJWT
+    else do
+      t@(_, signedJWT') <- mkApnsJWTToken appTeamId jwtHeader privateKey
+      atomically $ writeTVar jwtToken t
+      pure signedJWT'
+  where
+    jwtTokenAge (JWTToken _ JWTClaims {iat}) = (iat -) . systemSeconds <$> getSystemTime
+
+mkApnsJWTToken :: Text -> JWTHeader -> EC.PrivateKey -> IO (JWTToken, SignedJWTToken)
+mkApnsJWTToken appTeamId jwtHeader privateKey = do
+  jwt <- mkJWTToken jwtHeader appTeamId
+  signedJWT <- signedJWTToken privateKey jwt
+  pure (jwt, signedJWT)
+
+connectHTTPS2 :: APNSPushClientConfig -> TVar (Maybe HTTPS2Client) -> IO (Either HTTPS2ClientError HTTPS2Client)
+connectHTTPS2 APNSPushClientConfig {apnHost, apnPort, https2cfg} https2Client = do
+  r <- getHTTPS2Client apnHost apnPort https2cfg disconnected
+  case r of
+    Right client -> atomically . writeTVar https2Client $ Just client
+    Left e -> putStrLn $ "Error connecting to APNS: " <> show e
+  pure r
+  where
+    disconnected = atomically $ writeTVar https2Client Nothing
+
+getApnsHTTP2Client :: APNSPushClient -> IO (Either HTTPS2ClientError HTTPS2Client)
+getApnsHTTP2Client APNSPushClient {https2Client, apnsCfg} =
+  readTVarIO https2Client >>= maybe (connectHTTPS2 apnsCfg https2Client) (pure . Right)
+
+disconnectApnsHTTP2Client :: APNSPushClient -> IO ()
+disconnectApnsHTTP2Client APNSPushClient {https2Client} =
+  readTVarIO https2Client >>= mapM_ closeHTTPS2Client >> atomically (writeTVar https2Client Nothing)
+
+apnsNotification :: NtfTknData -> C.CbNonce -> Int -> PushNotification -> Either C.CryptoError APNSNotification
+apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
+  PNVerification (NtfRegCode code) ->
+    encrypt code $ \code' ->
+      apn APNSBackground {contentAvailable = 1} . Just $ J.object ["verification" .= code']
+  PNMessage srv nId ->
+    encrypt (strEncode srv <> "/" <> strEncode nId) $ \ntfQueue ->
+      apn apnMutableContent . Just $ J.object ["checkMessage" .= ntfQueue]
+  PNAlert text -> Right $ apn (apnAlert $ APNSAlertText text) Nothing
+  PNCheckMessages -> Right $ apn APNSBackground {contentAvailable = 1} . Just $ J.object ["checkMessages" .= True]
+  where
+    encrypt :: ByteString -> (Text -> APNSNotification) -> Either C.CryptoError APNSNotification
+    encrypt ntfData f = f . safeDecodeUtf8 . U.encode <$> C.cbEncrypt tknDhSecret nonce ntfData paddedLen
+    apn aps notificationData = APNSNotification {aps, notificationData}
+    apnMutableContent = APNSMutableContent {mutableContent = 1, alert = APNSAlertText "Encrypted message or some other app event", category = Nothing}
+    apnAlert alert = APNSAlert {alert, badge = Nothing, sound = Nothing, category = Nothing}
+    safeDecodeUtf8 = decodeUtf8With onError where onError _ _ = Just '?'
+
+apnsRequest :: APNSPushClient -> ByteString -> APNSNotification -> IO Request
+apnsRequest c tkn ntf@APNSNotification {aps} = do
+  signedJWT <- getApnsJWTToken c
+  pure $ H.requestBuilder methodPost path (headers signedJWT) (lazyByteString $ J.encode ntf)
+  where
+    path = "/3/device/" <> tkn
+    headers signedJWT =
+      [ (hApnsTopic, appName $ apnsCfg (c :: APNSPushClient)),
+        (hApnsPushType, pushType aps),
+        (hAuthorization, "bearer " <> signedJWT)
+      ]
+        <> [(hApnsPriority, "5") | isBackground aps]
+    isBackground = \case
+      APNSBackground {} -> True
+      _ -> False
+    pushType = \case
+      APNSBackground {} -> "background"
+      _ -> "alert"
+
+data PushProviderError
+  = PPConnection HTTPS2ClientError
+  | PPCryptoError C.CryptoError
+  | PPResponseError (Maybe Status) Text
+  | PPTokenInvalid
+  | PPRetryLater
+  | PPPermanentError
+  deriving (Show)
+
+type PushProviderClient = NtfTknData -> PushNotification -> ExceptT PushProviderError IO ()
+
+newtype APNSErrorReponse = APNSErrorReponse {reason :: Text}
+  deriving (Generic, FromJSON)
+
+apnsPushProviderClient :: APNSPushClient -> PushProviderClient
+apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {token = DeviceToken PPApple tknStr} pn = do
+  http2 <- liftHTTPS2 $ getApnsHTTP2Client c
+  nonce <- atomically $ C.pseudoRandomCbNonce nonceDrg
+  apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
+  liftIO $ putStrLn $ "APNS notification: " <> show apnsNtf
+  req <- liftIO $ apnsRequest c tknStr apnsNtf
+  liftIO $ putStrLn $ "APNS request: " <> show req
+  HTTP2Response {response, respBody} <- liftHTTPS2 $ sendRequest http2 req
+  let status = H.responseStatus response
+      reason = fromMaybe "" $ J.decodeStrict' =<< respBody
+  liftIO $ putStrLn $ "APNS response: " <> show status <> " " <> T.unpack reason
+  result status reason
+  where
+    result :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
+    result status reason
+      | status == Just N.ok200 = pure ()
+      | status == Just N.badRequest400 =
+        case reason of
+          "BadDeviceToken" -> throwError PPTokenInvalid
+          "DeviceTokenNotForTopic" -> throwError PPTokenInvalid
+          "TopicDisallowed" -> throwError PPPermanentError
+          _ -> err status reason
+      | status == Just N.forbidden403 = case reason of
+        "ExpiredProviderToken" -> throwError PPPermanentError -- there should be no point retrying it as the token was refreshed
+        "InvalidProviderToken" -> throwError PPPermanentError
+        _ -> err status reason
+      | status == Just N.gone410 = throwError PPTokenInvalid
+      | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwError PPRetryLater
+      -- Just tooManyRequests429 -> TODO TooManyRequests - too many requests for the same token
+      | otherwise = err status reason
+    err :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
+    err s r = throwError $ PPResponseError s r
+    liftHTTPS2 a = ExceptT $ first PPConnection <$> a
+
+hApnsTopic :: HeaderName
+hApnsTopic = CI.mk "apns-topic"
+
+hApnsPushType :: HeaderName
+hApnsPushType = CI.mk "apns-push-type"
+
+hApnsPriority :: HeaderName
+hApnsPriority = CI.mk "apns-priority"
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/testpush.sh b/src/Simplex/Messaging/Notifications/Server/Push/testpush.sh
new file mode 100755
index 000000000..204fce599
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Push/testpush.sh
@@ -0,0 +1,20 @@
+#!/bin/sh
+
+export TEAM_ID=5NN7GUYB6T
+# export APNS_KEY_FILE=""
+# export APNS_KEY_ID=""
+export TOPIC=chat.simplex.app
+# export DEVICE_TOKEN=""
+export APNS_HOST_NAME=api.sandbox.push.apple.com
+
+export JWT_ISSUE_TIME=$(date +%s)
+export JWT_HEADER=$(printf '{"alg":"ES256","kid":"%s"}' "${APNS_KEY_ID}" | openssl base64 -e -A | tr -- '+/' '-_' | tr -d =)
+export JWT_CLAIMS=$(printf '{"iss":"%s","iat":%d}' "${TEAM_ID}" "${JWT_ISSUE_TIME}" | openssl base64 -e -A | tr -- '+/' '-_' | tr -d =)
+export JWT_HEADER_CLAIMS="${JWT_HEADER}.${JWT_CLAIMS}"
+
+export JWT_SIGNED_HEADER_CLAIMS=$(printf "${JWT_HEADER_CLAIMS}" | openssl dgst -binary -sha256 -sign "${APNS_KEY_FILE}" | openssl base64 -e -A | tr -- '+/' '-_' | tr -d =)
+export AUTHENTICATION_TOKEN="${JWT_HEADER}.${JWT_CLAIMS}.${JWT_SIGNED_HEADER_CLAIMS}"
+
+# curl -v --header "apns-topic: $TOPIC" --header "apns-push-type: alert" --header "authorization: bearer $AUTHENTICATION_TOKEN" --data '{"aps":{"alert":"you have a new message"}}' --http2 https://${APNS_HOST_NAME}/3/device/${DEVICE_TOKEN}
+
+curl -v --header "apns-topic: $TOPIC" --header "apns-push-type: background" --header "apns-priority: 5" --header "authorization: bearer $AUTHENTICATION_TOKEN" --data '{"aps":{"content-available":1}}' --http2 https://${APNS_HOST_NAME}/3/device/${DEVICE_TOKEN}
diff --git a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
index fa5790d85..366ba26c2 100644
--- a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
@@ -2,21 +2,13 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Notifications.Server.Subscriptions where
 
 import Control.Concurrent.STM
-import Control.Monad
-import Crypto.PubKey.Curve25519 (dhSecret)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-import Data.Set (Set)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Protocol (ErrorType (..), NotifierId, NtfPrivateSignKey, ProtocolServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util ((<$$>))
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index c3d62bb02..eaa342c1d 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -23,7 +23,7 @@
 -- and optional append only log of SMP queue records.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md
-module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking, verifyCmdSignature, dummyVerifyCmd, randomBytes) where
+module Simplex.Messaging.Server (runSMPServer, runSMPServerBlocking, verifyCmdSignature, dummyVerifyCmd) where
 
 import Control.Monad
 import Control.Monad.Except
@@ -439,11 +439,4 @@ withLog action = do
 randomId :: (MonadUnliftIO m, MonadReader Env m) => Int -> m ByteString
 randomId n = do
   gVar <- asks idsDrg
-  atomically (randomBytes n gVar)
-
-randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
-randomBytes n gVar = do
-  g <- readTVar gVar
-  let (bytes, g') = randomBytesGenerate n g
-  writeTVar gVar g'
-  return bytes
+  atomically (C.pseudoRandomBytes n gVar)
diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs
index 3771da99e..cf24c75ef 100644
--- a/src/Simplex/Messaging/Transport/Client.hs
+++ b/src/Simplex/Messaging/Transport/Client.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Transport.Client
   ( runTransportClient,
+    runTLSTransportClient,
     smpClientHandshake,
   )
 where
@@ -26,9 +28,12 @@ import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E
 
 -- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
-runTransportClient host port keyHash keepAliveOpts client = do
-  let clientParams = mkTLSClientParams host port keyHash
+runTransportClient :: (Transport c, MonadUnliftIO m) => HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
+runTransportClient = runTLSTransportClient supportedParameters Nothing
+
+runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
+runTLSTransportClient tlsParams caStore_ host port keyHash keepAliveOpts client = do
+  let clientParams = mkTLSClientParams tlsParams caStore_ host port keyHash
   c <- liftIO $ startTCPClient host port clientParams keepAliveOpts
   client c `E.finally` liftIO (closeConnection c)
 
@@ -56,13 +61,15 @@ startTCPClient host port clientParams keepAliveOpts = withSocketsDo $ resolve >>
       ctx <- connectTLS clientParams sock
       getClientConnection ctx
 
-mkTLSClientParams :: HostName -> ServiceName -> C.KeyHash -> T.ClientParams
-mkTLSClientParams host port keyHash = do
+-- readCertificateStore :: FilePath -> IO (Maybe CertificateStore)
+
+mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> T.ClientParams
+mkTLSClientParams supported caStore_ host port keyHash_ = do
   let p = B.pack port
   (T.defaultParamsClient host p)
-    { T.clientShared = def,
-      T.clientHooks = def {T.onServerCertificate = \_ _ _ -> validateCertificateChain keyHash host p},
-      T.clientSupported = supportedParameters
+    { T.clientShared = maybe def (\caStore -> def {T.sharedCAStore = caStore}) caStore_,
+      T.clientHooks = maybe def (\keyHash -> def {T.onServerCertificate = \_ _ _ -> validateCertificateChain keyHash host p}) keyHash_,
+      T.clientSupported = supported
     }
 
 validateCertificateChain :: C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
diff --git a/src/Simplex/Messaging/Transport/Client/HTTP2.hs b/src/Simplex/Messaging/Transport/Client/HTTP2.hs
new file mode 100644
index 000000000..8e3a35741
--- /dev/null
+++ b/src/Simplex/Messaging/Transport/Client/HTTP2.hs
@@ -0,0 +1,169 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Transport.Client.HTTP2 where
+
+import Control.Concurrent.Async
+import Control.Exception (IOException, catch, finally)
+import qualified Control.Exception as E
+import Control.Monad.Except
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Default (def)
+import Data.Maybe (isNothing)
+import qualified Data.X509.CertificateStore as XS
+import Foreign (mallocBytes)
+import Network.HPACK (BufferSize, HeaderTable)
+import Network.HTTP2.Client (ClientConfig (..), Config (..), Request, Response)
+import qualified Network.HTTP2.Client as H
+import Network.Socket (HostName, ServiceName)
+import qualified Network.TLS as T
+import qualified Network.TLS.Extra as TE
+import Numeric.Natural (Natural)
+import Simplex.Messaging.Transport (TLS, Transport (cGet, cPut))
+import Simplex.Messaging.Transport.Client (runTLSTransportClient)
+import Simplex.Messaging.Transport.KeepAlive (KeepAliveOpts)
+import qualified System.TimeManager as TI
+import UnliftIO.STM
+import UnliftIO.Timeout
+
+data HTTPS2Client = HTTPS2Client
+  { action :: Async (),
+    connected :: TVar Bool,
+    host :: HostName,
+    port :: ServiceName,
+    config :: HTTP2SClientConfig,
+    reqQ :: TBQueue (Request, TMVar HTTP2Response)
+  }
+
+data HTTP2Response = HTTP2Response
+  { response :: Response,
+    respBody :: Maybe ByteString,
+    respTrailers :: Maybe HeaderTable
+  }
+
+data HTTP2SClientConfig = HTTP2SClientConfig
+  { qSize :: Natural,
+    maxBody :: Int,
+    connTimeout :: Int,
+    tcpKeepAlive :: Maybe KeepAliveOpts,
+    caStoreFile :: FilePath,
+    suportedTLSParams :: T.Supported
+  }
+  deriving (Show)
+
+defaultHTTP2SClientConfig :: HTTP2SClientConfig
+defaultHTTP2SClientConfig =
+  HTTP2SClientConfig
+    { qSize = 64,
+      maxBody = 500000,
+      connTimeout = 5000000,
+      tcpKeepAlive = Nothing,
+      caStoreFile = "/etc/ssl/cert.pem",
+      suportedTLSParams =
+        def
+          { T.supportedVersions = [T.TLS13, T.TLS12],
+            T.supportedCiphers = TE.ciphersuite_strong_det,
+            T.supportedSecureRenegotiation = False
+          }
+    }
+
+data HTTPS2ClientError = HCResponseTimeout | HCNetworkError | HCIOError IOException
+  deriving (Show)
+
+getHTTPS2Client :: HostName -> ServiceName -> HTTP2SClientConfig -> IO () -> IO (Either HTTPS2ClientError HTTPS2Client)
+getHTTPS2Client host port config@HTTP2SClientConfig {tcpKeepAlive, connTimeout, caStoreFile, suportedTLSParams} disconnected =
+  (atomically mkHTTPS2Client >>= runClient)
+    `catch` \(e :: IOException) -> pure . Left $ HCIOError e
+  where
+    mkHTTPS2Client :: STM HTTPS2Client
+    mkHTTPS2Client = do
+      connected <- newTVar False
+      reqQ <- newTBQueue $ qSize config
+      pure HTTPS2Client {action = undefined, connected, host, port, config, reqQ}
+
+    runClient :: HTTPS2Client -> IO (Either HTTPS2ClientError HTTPS2Client)
+    runClient c = do
+      cVar <- newEmptyTMVarIO
+      caStore <- XS.readCertificateStore caStoreFile
+      when (isNothing caStore) . putStrLn $ "Error loading CertificateStore from " <> caStoreFile
+      action <-
+        async $
+          runHTTPS2Client suportedTLSParams caStore host port tcpKeepAlive (client c cVar)
+            `finally` atomically (putTMVar cVar $ Left HCNetworkError)
+      conn_ <- connTimeout `timeout` atomically (takeTMVar cVar)
+      pure $ case conn_ of
+        Just (Right ()) -> Right c {action}
+        Just (Left e) -> Left e
+        Nothing -> Left HCNetworkError
+
+    client :: HTTPS2Client -> TMVar (Either HTTPS2ClientError ()) -> (Request -> (Response -> IO ()) -> IO ()) -> IO ()
+    client c cVar sendReq = do
+      atomically $ do
+        writeTVar (connected c) True
+        putTMVar cVar $ Right ()
+      process c sendReq `finally` disconnected
+
+    process :: HTTPS2Client -> (Request -> (Response -> IO ()) -> IO ()) -> IO ()
+    process HTTPS2Client {reqQ} sendReq = forever $ do
+      (req, respVar) <- atomically $ readTBQueue reqQ
+      sendReq req $ \r -> do
+        let writeResp respBody respTrailers = atomically $ putTMVar respVar HTTP2Response {response = r, respBody, respTrailers}
+        case H.responseBodySize r of
+          Just sz ->
+            if sz <= maxBody config
+              then do
+                respBody <- getResponseBody r "" sz
+                respTrailers <- join <$> mapM (const $ H.getResponseTrailers r) respBody
+                writeResp respBody respTrailers
+              else writeResp Nothing Nothing
+          _ -> writeResp Nothing Nothing
+
+    getResponseBody :: Response -> ByteString -> Int -> IO (Maybe ByteString)
+    getResponseBody r s sz =
+      H.getResponseBodyChunk r >>= \chunk -> do
+        if chunk == ""
+          then pure (if B.length s == sz then Just s else Nothing)
+          else do
+            let s' = s <> chunk
+            if B.length s' > sz then pure Nothing else getResponseBody r s' sz
+
+-- | Disconnects client from the server and terminates client threads.
+closeHTTPS2Client :: HTTPS2Client -> IO ()
+-- TODO disconnect
+closeHTTPS2Client = uninterruptibleCancel . action
+
+sendRequest :: HTTPS2Client -> Request -> IO (Either HTTPS2ClientError HTTP2Response)
+sendRequest HTTPS2Client {reqQ, config} req = do
+  resp <- newEmptyTMVarIO
+  atomically $ writeTBQueue reqQ (req, resp)
+  maybe (Left HCResponseTimeout) Right <$> (connTimeout config `timeout` atomically (takeTMVar resp))
+
+runHTTPS2Client :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe KeepAliveOpts -> ((Request -> (Response -> IO ()) -> IO ()) -> IO ()) -> IO ()
+runHTTPS2Client tlsParams caStore host port keepAliveOpts client =
+  runTLSTransportClient tlsParams caStore host port Nothing keepAliveOpts https2Client
+  where
+    cfg = ClientConfig "https" (B.pack host) 20
+    https2Client :: TLS -> IO ()
+    https2Client c =
+      E.bracket
+        (allocTlsConfig c 16384)
+        H.freeSimpleConfig
+        (\conf -> H.run cfg conf client)
+
+    allocTlsConfig :: TLS -> BufferSize -> IO Config
+    allocTlsConfig c sz = do
+      buf <- mallocBytes sz
+      tm <- TI.initialize $ 30 * 1000000
+      pure
+        Config
+          { confWriteBuffer = buf,
+            confBufferSize = sz,
+            confSendAll = cPut c,
+            confReadN = cGet c,
+            confPositionReadMaker = H.defaultPositionReadMaker,
+            confTimeoutManager = tm
+          }
diff --git a/src/Simplex/Messaging/Transport/KeepAlive.hs b/src/Simplex/Messaging/Transport/KeepAlive.hs
index c949394a0..08d17d47c 100644
--- a/src/Simplex/Messaging/Transport/KeepAlive.hs
+++ b/src/Simplex/Messaging/Transport/KeepAlive.hs
@@ -12,6 +12,7 @@ data KeepAliveOpts = KeepAliveOpts
     keepIntvl :: Int,
     keepCnt :: Int
   }
+  deriving (Show)
 
 defaultKeepAliveOpts :: KeepAliveOpts
 defaultKeepAliveOpts =
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index bb7f6dec6..c9ef301ab 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -19,6 +19,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
+import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
@@ -40,7 +41,7 @@ testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 
 testNtfClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testNtfClient client =
-  runTransportClient testHost testPort testKeyHash (Just defaultKeepAliveOpts) $ \h ->
+  runTransportClient testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
     liftIO (runExceptT $ ntfClientHandshake h testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e
@@ -55,6 +56,7 @@ cfg =
       subQSize = 1,
       pushQSize = 1,
       smpAgentCfg = defaultSMPClientAgentConfig,
+      apnsConfig = defaultAPNSPushClientConfig,
       -- CA certificate private key is not needed for initialization
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index 93195e8ac..680676dea 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -1,11 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 
 module NtfServerTests where
 
@@ -37,4 +33,4 @@ ntfSyntaxTests (ATransport t) = do
       (Maybe C.ASignature, ByteString, ByteString, smp) ->
       (Maybe C.ASignature, ByteString, ByteString, BrokerMsg) ->
       Expectation
-    command >#> response = ntfServerTest t command `shouldReturn` response
\ No newline at end of file
+    command >#> response = ntfServerTest t command `shouldReturn` response
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index 304ba9674..be3de3e2c 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -198,7 +198,7 @@ withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)
 
 testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a
 testSMPAgentClientOn port' client = do
-  runTransportClient agentTestHost port' testKeyHash (Just defaultKeepAliveOpts) $ \h -> do
+  runTransportClient agentTestHost port' (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> do
     line <- liftIO $ getLn h
     if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion
       then client h
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index e5a57ab72..90f090b6f 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -45,7 +45,7 @@ testStoreLogFile = "tests/tmp/smp-server-store.log"
 
 testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
-  runTransportClient testHost testPort testKeyHash (Just defaultKeepAliveOpts) $ \h ->
+  runTransportClient testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
     liftIO (runExceptT $ smpClientHandshake h testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e

From 9d8a9c4fe4dd5aa4095306c6c2b0e9bea50a7803 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 17 Apr 2022 10:34:51 +0100
Subject: [PATCH 07/12] interval notifications (TCRN command) (#352)

* notifications: periodic notifications

* agent: allow repeat token registrations, delete old tokens from notification server (e.g., when database is moved to another device)

* decrypt token verification code in the agent

* check token status, send TCRN on registration if it was enabled

* fix http2/apns response handling for error responses (also, APNS seems not to send content-length header?)
---
 apps/ntf-server/Main.hs                       |   8 +-
 src/Simplex/Messaging/Agent.hs                |  82 +++++++-----
 src/Simplex/Messaging/Agent/Client.hs         |   5 +
 src/Simplex/Messaging/Agent/Store.hs          |   3 +-
 src/Simplex/Messaging/Agent/Store/SQLite.hs   |  54 +++++---
 .../Migrations/M20220322_notifications.hs     |   5 +-
 src/Simplex/Messaging/Crypto.hs               |   9 ++
 src/Simplex/Messaging/Notifications/Client.hs |  28 ++--
 .../Messaging/Notifications/Protocol.hs       |  75 ++++++-----
 src/Simplex/Messaging/Notifications/Server.hs | 123 +++++++++++-------
 .../Messaging/Notifications/Server/Env.hs     |  18 ++-
 .../Notifications/Server/Push/APNS.hs         |  41 +++---
 .../Notifications/Server/Subscriptions.hs     |  15 ++-
 .../Messaging/Transport/Client/HTTP2.hs       |  32 ++---
 tests/AgentTests/FunctionalAPITests.hs        |   4 +-
 15 files changed, 312 insertions(+), 190 deletions(-)

diff --git a/apps/ntf-server/Main.hs b/apps/ntf-server/Main.hs
index 478077e25..41625d6f2 100644
--- a/apps/ntf-server/Main.hs
+++ b/apps/ntf-server/Main.hs
@@ -2,6 +2,7 @@
 
 module Main where
 
+import Control.Logger.Simple
 import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
 import Simplex.Messaging.Notifications.Server (runNtfServer)
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
@@ -15,8 +16,13 @@ cfgPath = "/etc/opt/simplex-notifications"
 logPath :: FilePath
 logPath = "/var/opt/simplex-notifications"
 
+logCfg :: LogConfig
+logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
+
 main :: IO ()
-main = protocolServerCLI ntfServerCLIConfig runNtfServer
+main = do
+  setLogLevel LogDebug -- TODO change to LogError in production
+  withGlobalLogging logCfg $ protocolServerCLI ntfServerCLIConfig runNtfServer
 
 ntfServerCLIConfig :: ServerCLIConfig NtfServerConfig
 ntfServerCLIConfig =
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 705b3d248..4ed89185a 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -63,7 +63,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
-import Data.Bifunctor (first, second)
+import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Char8 (ByteString)
 import Data.Composition ((.:), (.:.))
 import Data.Functor (($>))
@@ -87,7 +87,7 @@ import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Client
-import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode, NtfTknStatus (..))
+import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..))
 import Simplex.Messaging.Parsers (parse)
 import Simplex.Messaging.Protocol (BrokerMsg, MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
@@ -165,8 +165,8 @@ registerNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> m ()
 registerNtfToken c = withAgentEnv c . registerNtfToken' c
 
 -- | Verify device notifications token
-verifyNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> NtfRegCode -> m ()
-verifyNtfToken c = withAgentEnv c .: verifyNtfToken' c
+verifyNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> ByteString -> C.CbNonce -> m ()
+verifyNtfToken c = withAgentEnv c .:. verifyNtfToken' c
 
 -- | Enable/disable periodic notifications
 enableNtfCron :: AgentErrorMonad m => AgentClient -> DeviceToken -> Word16 -> m ()
@@ -523,60 +523,78 @@ setSMPServers' c servers = do
 registerNtfToken' :: forall m. AgentMonad m => AgentClient -> DeviceToken -> m ()
 registerNtfToken' c deviceToken =
   withStore (`getDeviceNtfToken` deviceToken) >>= \case
-    Just tkn@NtfToken {ntfTokenId, ntfTknAction} -> case (ntfTokenId, ntfTknAction) of
-      (Nothing, Just (NTARegister ntfPubKey)) -> registerToken tkn ntfPubKey
-      -- TODO request verification code again in case there is registration, but no verification code in DB - probably after some timeout?
-      (Just tknId, Just (NTAVerify code)) ->
-        t tkn (NTActive, Just NTACheck) $ agentNtfVerifyToken c tknId tkn code
-      (Just tknId, Just (NTACron interval)) ->
-        t tkn (NTActive, Just NTACheck) $ agentNtfEnableCron c tknId tkn interval
-      (Just _tknId, Just NTACheck) -> pure ()
-      (Just tknId, Just NTADelete) ->
-        t tkn (NTExpired, Nothing) $ agentNtfDeleteToken c tknId tkn
-      _ -> pure ()
+    (Just tkn@NtfToken {ntfTokenId, ntfTknStatus, ntfTknAction}, prevTokens) -> do
+      mapM_ (deleteToken_ c) prevTokens
+      case (ntfTokenId, ntfTknAction) of
+        (Nothing, Just NTARegister) -> registerToken tkn
+        -- TODO minimal time before repeat registration
+        (Just _, Nothing) -> when (ntfTknStatus == NTRegistered) $ registerToken tkn
+        (Just tknId, Just (NTAVerify code)) ->
+          t tkn (NTActive, Just NTACheck) $ agentNtfVerifyToken c tknId tkn code
+        (Just tknId, Just (NTACron interval)) ->
+          t tkn (cronSuccess interval) $ agentNtfEnableCron c tknId tkn interval
+        (Just _tknId, Just NTACheck) -> pure () -- TODO
+        -- agentNtfCheckToken c tknId tkn >>= \case
+        (Just tknId, Just NTADelete) -> do
+          agentNtfDeleteToken c tknId tkn
+          withStore $ \st -> removeNtfToken st tkn
+        _ -> pure ()
     _ ->
       getNtfServer c >>= \case
         Just ntfServer ->
           asks (cmdSignAlg . config) >>= \case
             C.SignAlg a -> do
-              (ntfPubKey, ntfPrivKey) <- liftIO $ C.generateSignatureKeyPair a
-              let tkn = newNtfToken deviceToken ntfServer ntfPrivKey ntfPubKey
+              tknKeys <- liftIO $ C.generateSignatureKeyPair a
+              dhKeys <- liftIO C.generateKeyPair'
+              let tkn = newNtfToken deviceToken ntfServer tknKeys dhKeys
               withStore $ \st -> createNtfToken st tkn
-              registerToken tkn ntfPubKey
+              registerToken tkn
         _ -> throwError $ CMD PROHIBITED
   where
     t tkn = withToken tkn Nothing
-    registerToken :: NtfToken -> C.APublicVerifyKey -> m ()
-    registerToken tkn ntfPubKey = do
-      (pubDhKey, privDhKey) <- liftIO C.generateKeyPair'
+    registerToken :: NtfToken -> m ()
+    registerToken tkn@NtfToken {ntfPubKey, ntfDhKeys = (pubDhKey, privDhKey)} = do
       (tknId, srvPubDhKey) <- agentNtfRegisterToken c tkn ntfPubKey pubDhKey
       let dhSecret = C.dh' srvPubDhKey privDhKey
       withStore $ \st -> updateNtfTokenRegistration st tkn tknId dhSecret
 
-verifyNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> NtfRegCode -> m ()
-verifyNtfToken' c deviceToken code =
+-- TODO decrypt verification code
+verifyNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> ByteString -> C.CbNonce -> m ()
+verifyNtfToken' c deviceToken code nonce =
   withStore (`getDeviceNtfToken` deviceToken) >>= \case
-    Just tkn@NtfToken {ntfTokenId = Just tknId} ->
-      withToken tkn (Just (NTConfirmed, NTAVerify code)) (NTActive, Just NTACheck) $
-        agentNtfVerifyToken c tknId tkn code
+    (Just tkn@NtfToken {ntfTokenId = Just tknId, ntfDhSecret = Just dhSecret}, _) -> do
+      code' <- liftEither . bimap cryptoError NtfRegCode $ C.cbDecrypt dhSecret nonce code
+      withToken tkn (Just (NTConfirmed, NTAVerify code')) (NTActive, Just NTACheck) $
+        agentNtfVerifyToken c tknId tkn code'
     _ -> throwError $ CMD PROHIBITED
 
 enableNtfCron' :: AgentMonad m => AgentClient -> DeviceToken -> Word16 -> m ()
-enableNtfCron' c deviceToken interval =
+enableNtfCron' c deviceToken interval = do
+  when (interval < 20) . throwError $ CMD PROHIBITED
   withStore (`getDeviceNtfToken` deviceToken) >>= \case
-    Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus = NTActive} ->
-      withToken tkn (Just (NTActive, NTACron interval)) (NTActive, Just NTACheck) $
+    (Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus = NTActive}, _) ->
+      withToken tkn (Just (NTActive, NTACron interval)) (cronSuccess interval) $
         agentNtfEnableCron c tknId tkn interval
     _ -> throwError $ CMD PROHIBITED
 
+cronSuccess :: Word16 -> (NtfTknStatus, Maybe NtfTknAction)
+cronSuccess interval
+  | interval == 0 = (NTActive, Just NTACheck)
+  | otherwise = (NTActive, Just $ NTACron interval)
+
 deleteNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> m ()
 deleteNtfToken' c deviceToken =
   withStore (`getDeviceNtfToken` deviceToken) >>= \case
-    Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus} ->
-      withToken tkn (Just (ntfTknStatus, NTADelete)) (NTExpired, Nothing) $
-        agentNtfDeleteToken c tknId tkn
+    (Just tkn, _) -> deleteToken_ c tkn
     _ -> throwError $ CMD PROHIBITED
 
+deleteToken_ :: AgentMonad m => AgentClient -> NtfToken -> m ()
+deleteToken_ c tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
+  forM_ ntfTokenId $ \tknId -> do
+    withStore $ \st -> updateNtfToken st tkn ntfTknStatus (Just NTADelete)
+    agentNtfDeleteToken c tknId tkn
+  withStore $ \st -> removeNtfToken st tkn
+
 withToken :: AgentMonad m => NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> m a -> m a
 withToken tkn from_ (toStatus, toAction_) f = do
   forM_ from_ $ \(status, action) -> withStore $ \st -> updateNtfToken st tkn status (Just action)
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 8d51a3c9b..8108f36fd 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -25,6 +25,7 @@ module Simplex.Messaging.Agent.Client
     sendAgentMessage,
     agentNtfRegisterToken,
     agentNtfVerifyToken,
+    agentNtfCheckToken,
     agentNtfDeleteToken,
     agentNtfEnableCron,
     agentCbEncrypt,
@@ -478,6 +479,10 @@ agentNtfVerifyToken :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken ->
 agentNtfVerifyToken c tknId NtfToken {ntfServer, ntfPrivKey} code =
   withLogClient c ntfServer tknId "TVFY" $ \ntf -> ntfVerifyToken ntf ntfPrivKey tknId code
 
+agentNtfCheckToken :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> m NtfTknStatus
+agentNtfCheckToken c tknId NtfToken {ntfServer, ntfPrivKey} =
+  withLogClient c ntfServer tknId "TCHK" $ \ntf -> ntfCheckToken ntf ntfPrivKey tknId
+
 agentNtfDeleteToken :: AgentMonad m => AgentClient -> NtfTokenId -> NtfToken -> m ()
 agentNtfDeleteToken c tknId NtfToken {ntfServer, ntfPrivKey} =
   withLogClient c ntfServer tknId "TDEL" $ \ntf -> ntfDeleteToken ntf ntfPrivKey tknId
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index 5a2c246ac..6931f53be 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -81,9 +81,10 @@ class Monad m => MonadAgentStore s m where
   createNtfToken :: s -> NtfToken -> m ()
 
   -- TODO this should also return old tokens so that they are deleted from the server
-  getDeviceNtfToken :: s -> DeviceToken -> m (Maybe NtfToken) -- return current token if it exists
+  getDeviceNtfToken :: s -> DeviceToken -> m (Maybe NtfToken, [NtfToken]) -- return current token if it exists
   updateNtfTokenRegistration :: s -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> m ()
   updateNtfToken :: s -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> m ()
+  removeNtfToken :: s -> NtfToken -> m ()
 
 -- * Queue types
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 52235f852..0400ef07e 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -33,12 +33,12 @@ import Control.Exception (bracket)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Crypto.Random (ChaChaDRG, randomBytesGenerate)
-import Data.Bifunctor (second)
+import Data.Bifunctor (first, second)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as U
 import Data.Char (toLower)
 import Data.Functor (($>))
-import Data.List (find, foldl')
+import Data.List (find, foldl', partition)
 import qualified Data.Map.Strict as M
 import Data.Maybe (listToMaybe)
 import Data.Text (Text)
@@ -567,35 +567,36 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
               DB.execute db "INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)" (connId, hk, msgN, mk)
 
   createNtfToken :: SQLiteStore -> NtfToken -> m ()
-  createNtfToken st NtfToken {deviceToken = DeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction} =
+  createNtfToken st NtfToken {deviceToken = DeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction} =
     liftIO . withTransaction st $ \db -> do
       upsertNtfServer_ db srv
       DB.execute
         db
         [sql|
           INSERT INTO ntf_tokens
-            (provider, device_token, ntf_host, ntf_port, tkn_id, tkn_priv_key, tkn_dh_secret, tkn_status, tkn_action) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)
+            (provider, device_token, ntf_host, ntf_port, tkn_id, tkn_pub_key, tkn_priv_key, tkn_pub_dh_key, tkn_priv_dh_key, tkn_dh_secret, tkn_status, tkn_action) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
         |]
-        (provider, token, host, port, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction)
+        (provider, token, host, port, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction)
 
-  getDeviceNtfToken :: SQLiteStore -> DeviceToken -> m (Maybe NtfToken)
-  getDeviceNtfToken st t@(DeviceToken provider token) =
-    liftIO . withTransaction st $ \db ->
-      fmap ntfToken . listToMaybe
-        <$> DB.query
-          db
-          [sql|
-            SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
-              t.tkn_id, t.tkn_priv_key, t.tkn_dh_secret, t.tkn_status, t.tkn_action
-            FROM ntf_tokens t
-            JOIN ntf_servers s USING (ntf_host, ntf_port)
-            WHERE t.provider = ? AND t.device_token = ?
-          |]
-          (provider, token)
+  getDeviceNtfToken :: SQLiteStore -> DeviceToken -> m (Maybe NtfToken, [NtfToken])
+  getDeviceNtfToken st t =
+    liftIO . withTransaction st $ \db -> do
+      tokens <-
+        map ntfToken
+          <$> DB.query_
+            db
+            [sql|
+              SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
+                t.tkn_id, t.tkn_pub_key, t.tkn_priv_key, t.tkn_pub_dh_key, t.tkn_priv_dh_key, t.tkn_dh_secret, t.tkn_status, t.tkn_action
+              FROM ntf_tokens t
+              JOIN ntf_servers s USING (ntf_host, ntf_port)
+            |]
+      pure . first listToMaybe $ partition ((t ==) . deviceToken) tokens
     where
-      ntfToken (host, port, keyHash, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction) =
+      ntfToken (host, port, keyHash, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction) =
         let ntfServer = ProtocolServer {host, port, keyHash}
-         in NtfToken {deviceToken = t, ntfServer, ntfTokenId, ntfPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction}
+            ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
+         in NtfToken {deviceToken = t, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction}
 
   updateNtfTokenRegistration :: SQLiteStore -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> m ()
   updateNtfTokenRegistration st NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret =
@@ -623,6 +624,17 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
         |]
         (tknStatus, tknAction, updatedAt, provider, token, host, port)
 
+  removeNtfToken :: SQLiteStore -> NtfToken -> m ()
+  removeNtfToken st NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} =
+    liftIO . withTransaction st $ \db ->
+      DB.execute
+        db
+        [sql|
+          DELETE FROM ntf_tokens
+          WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ?
+        |]
+        (provider, token, host, port)
+
 -- * Auxiliary helpers
 
 instance ToField QueueStatus where toField = toField . serializeQueueStatus
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
index 3587e05b1..4b93c0db9 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220322_notifications.hs
@@ -23,7 +23,10 @@ CREATE TABLE ntf_tokens (
   ntf_host TEXT NOT NULL,
   ntf_port TEXT NOT NULL,
   tkn_id BLOB, -- token ID assigned by notifications server
-  tkn_priv_key BLOB NOT NULL, -- private key to sign token commands
+  tkn_pub_key BLOB NOT NULL, -- client's public key to verify token commands (used by server, for repeat registraions)
+  tkn_priv_key BLOB NOT NULL, -- client's private key to sign token commands
+  tkn_pub_dh_key BLOB NOT NULL, -- client's public DH key (for repeat registraions)
+  tkn_priv_dh_key BLOB NOT NULL, -- client's private DH key (for repeat registraions)
   tkn_dh_secret BLOB, -- DH secret for e2e encryption of notifications
   tkn_status TEXT NOT NULL,
   tkn_action BLOB,
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 9f275e805..7caa6dedb 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -52,6 +52,7 @@ module Simplex.Messaging.Crypto
     CryptoPublicKey (..),
     CryptoPrivateKey (..),
     KeyPair,
+    ASignatureKeyPair,
     DhSecret (..),
     DhSecretX25519,
     ADhSecret (..),
@@ -870,6 +871,14 @@ cbDecrypt secret (CbNonce nonce) packet
 newtype CbNonce = CbNonce {unCbNonce :: ByteString}
   deriving (Show)
 
+instance StrEncoding CbNonce where
+  strEncode (CbNonce s) = strEncode s
+  strP = cbNonce <$> strP
+
+instance ToJSON CbNonce where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
 cbNonce :: ByteString -> CbNonce
 cbNonce s
   | len == 24 = CbNonce s
diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs
index 572831c8b..f7dc4fc52 100644
--- a/src/Simplex/Messaging/Notifications/Client.hs
+++ b/src/Simplex/Messaging/Notifications/Client.hs
@@ -33,6 +33,12 @@ ntfRegisterToken c pKey newTkn =
 ntfVerifyToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> NtfRegCode -> ExceptT ProtocolClientError IO ()
 ntfVerifyToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
 
+ntfCheckToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> ExceptT ProtocolClientError IO NtfTknStatus
+ntfCheckToken c pKey tknId =
+  sendNtfCommand c (Just pKey) tknId TCHK >>= \case
+    NRTkn stat -> pure stat
+    _ -> throwE PCEUnexpectedResponse
+
 ntfDeleteToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> ExceptT ProtocolClientError IO ()
 ntfDeleteToken = okNtfCommand TDEL
 
@@ -48,7 +54,7 @@ ntfCreateSubsciption c pKey newSub =
 ntfCheckSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO NtfSubStatus
 ntfCheckSubscription c pKey subId =
   sendNtfCommand c (Just pKey) subId SCHK >>= \case
-    NRStat stat -> pure stat
+    NRSub stat -> pure stat
     _ -> throwE PCEUnexpectedResponse
 
 ntfDeleteSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO ()
@@ -65,7 +71,7 @@ okNtfCommand cmd c pKey entId =
     _ -> throwE PCEUnexpectedResponse
 
 data NtfTknAction
-  = NTARegister C.APublicVerifyKey -- public key to send to the server
+  = NTARegister
   | NTAVerify NtfRegCode -- code to verify token
   | NTACheck
   | NTACron Word16
@@ -74,14 +80,14 @@ data NtfTknAction
 
 instance Encoding NtfTknAction where
   smpEncode = \case
-    NTARegister key -> smpEncode ('R', key)
+    NTARegister -> "R"
     NTAVerify code -> smpEncode ('V', code)
     NTACheck -> "C"
     NTACron interval -> smpEncode ('I', interval)
     NTADelete -> "D"
   smpP =
     A.anyChar >>= \case
-      'R' -> NTARegister <$> smpP
+      'R' -> pure NTARegister
       'V' -> NTAVerify <$> smpP
       'C' -> pure NTACheck
       'I' -> NTACron <$> smpP
@@ -96,8 +102,12 @@ data NtfToken = NtfToken
   { deviceToken :: DeviceToken,
     ntfServer :: NtfServer,
     ntfTokenId :: Maybe NtfTokenId,
+    -- | key used by the ntf server to verify transmissions
+    ntfPubKey :: C.APublicVerifyKey,
     -- | key used by the ntf client to sign transmissions
     ntfPrivKey :: C.APrivateSignKey,
+    -- | client's DH keys (to repeat registration if necessary)
+    ntfDhKeys :: C.KeyPair 'C.X25519,
     -- | shared DH secret used to encrypt/decrypt notifications e2e
     ntfDhSecret :: Maybe C.DhSecretX25519,
     -- | token status
@@ -107,14 +117,16 @@ data NtfToken = NtfToken
   }
   deriving (Show)
 
-newNtfToken :: DeviceToken -> NtfServer -> C.APrivateSignKey -> C.APublicVerifyKey -> NtfToken
-newNtfToken deviceToken ntfServer ntfPrivKey ntfPubKey =
+newNtfToken :: DeviceToken -> NtfServer -> C.ASignatureKeyPair -> C.KeyPair 'C.X25519 -> NtfToken
+newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys =
   NtfToken
     { deviceToken,
       ntfServer,
       ntfTokenId = Nothing,
+      ntfPubKey,
       ntfPrivKey,
+      ntfDhKeys,
       ntfDhSecret = Nothing,
       ntfTknStatus = NTNew,
-      ntfTknAction = Just $ NTARegister ntfPubKey
-    }
\ No newline at end of file
+      ntfTknAction = Just NTARegister
+    }
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 17c6ece56..d5985d213 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -16,6 +16,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Kind
 import Data.Maybe (isNothing)
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Type.Equality
 import Data.Word (Word16)
 import Database.SQLite.Simple.FromField (FromField (..))
@@ -51,6 +52,7 @@ instance NtfEntityI 'Subscription where sNtfEntity = SSubscription
 data NtfCommandTag (e :: NtfEntity) where
   TNEW_ :: NtfCommandTag 'Token
   TVFY_ :: NtfCommandTag 'Token
+  TCHK_ :: NtfCommandTag 'Token
   TDEL_ :: NtfCommandTag 'Token
   TCRN_ :: NtfCommandTag 'Token
   SNEW_ :: NtfCommandTag 'Subscription
@@ -66,6 +68,7 @@ instance NtfEntityI e => Encoding (NtfCommandTag e) where
   smpEncode = \case
     TNEW_ -> "TNEW"
     TVFY_ -> "TVFY"
+    TCHK_ -> "TCHK"
     TDEL_ -> "TDEL"
     TCRN_ -> "TCRN"
     SNEW_ -> "SNEW"
@@ -82,6 +85,7 @@ instance ProtocolMsgTag NtfCmdTag where
   decodeTag = \case
     "TNEW" -> Just $ NCT SToken TNEW_
     "TVFY" -> Just $ NCT SToken TVFY_
+    "TCHK" -> Just $ NCT SToken TCHK_
     "TDEL" -> Just $ NCT SToken TDEL_
     "TCRN" -> Just $ NCT SToken TCRN_
     "SNEW" -> Just $ NCT SSubscription SNEW_
@@ -147,6 +151,8 @@ data NtfCommand (e :: NtfEntity) where
   TNEW :: NewNtfEntity 'Token -> NtfCommand 'Token
   -- | verify token - uses e2e encrypted random string sent to the device via PN to confirm that the device has the token
   TVFY :: NtfRegCode -> NtfCommand 'Token
+  -- | check token status
+  TCHK :: NtfCommand 'Token
   -- | delete token - all subscriptions will be removed and no more notifications will be sent
   TDEL :: NtfCommand 'Token
   -- | enable periodic background notification to fetch the new messages - interval is in minutes, minimum is 20, 0 to disable
@@ -171,6 +177,7 @@ instance NtfEntityI e => ProtocolEncoding (NtfCommand e) where
   encodeProtocol = \case
     TNEW newTkn -> e (TNEW_, ' ', newTkn)
     TVFY code -> e (TVFY_, ' ', code)
+    TCHK -> e TCHK_
     TDEL -> e TDEL_
     TCRN int -> e (TCRN_, ' ', int)
     SNEW newSub -> e (SNEW_, ' ', newSub)
@@ -209,6 +216,7 @@ instance ProtocolEncoding NtfCmd where
       NtfCmd SToken <$> case tag of
         TNEW_ -> TNEW <$> _smpP
         TVFY_ -> TVFY <$> _smpP
+        TCHK_ -> pure TCHK
         TDEL_ -> pure TDEL
         TCRN_ -> TCRN <$> _smpP
     NCT SSubscription tag ->
@@ -224,7 +232,8 @@ data NtfResponseTag
   = NRId_
   | NROk_
   | NRErr_
-  | NRStat_
+  | NRTkn_
+  | NRSub_
   | NRPong_
   deriving (Show)
 
@@ -233,7 +242,8 @@ instance Encoding NtfResponseTag where
     NRId_ -> "ID"
     NROk_ -> "OK"
     NRErr_ -> "ERR"
-    NRStat_ -> "STAT"
+    NRTkn_ -> "TKN"
+    NRSub_ -> "SUB"
     NRPong_ -> "PONG"
   smpP = messageTagP
 
@@ -242,7 +252,8 @@ instance ProtocolMsgTag NtfResponseTag where
     "ID" -> Just NRId_
     "OK" -> Just NROk_
     "ERR" -> Just NRErr_
-    "STAT" -> Just NRStat_
+    "TKN" -> Just NRTkn_
+    "SUB" -> Just NRSub_
     "PONG" -> Just NRPong_
     _ -> Nothing
 
@@ -250,7 +261,8 @@ data NtfResponse
   = NRId NtfEntityId C.PublicKeyX25519
   | NROk
   | NRErr ErrorType
-  | NRStat NtfSubStatus
+  | NRTkn NtfTknStatus
+  | NRSub NtfSubStatus
   | NRPong
 
 instance ProtocolEncoding NtfResponse where
@@ -259,7 +271,8 @@ instance ProtocolEncoding NtfResponse where
     NRId entId dhKey -> e (NRId_, ' ', entId, dhKey)
     NROk -> e NROk_
     NRErr err -> e (NRErr_, ' ', err)
-    NRStat stat -> e (NRStat_, ' ', stat)
+    NRTkn stat -> e (NRTkn_, ' ', stat)
+    NRSub stat -> e (NRSub_, ' ', stat)
     NRPong -> e NRPong_
     where
       e :: Encoding a => a -> ByteString
@@ -269,7 +282,8 @@ instance ProtocolEncoding NtfResponse where
     NRId_ -> NRId <$> _smpP <*> smpP
     NROk_ -> pure NROk
     NRErr_ -> NRErr <$> _smpP
-    NRStat_ -> NRStat <$> _smpP
+    NRTkn_ -> NRTkn <$> _smpP
+    NRSub_ -> NRSub <$> _smpP
     NRPong_ -> pure NRPong
 
   checkCredentials (_, _, entId, _) cmd = case cmd of
@@ -301,22 +315,22 @@ instance Encoding SMPQueueNtf where
     (smpServer, notifierId, notifierKey) <- smpP
     pure $ SMPQueueNtf smpServer notifierId notifierKey
 
-data PushProvider = PPApple
+data PushProvider = PPApns
   deriving (Eq, Ord, Show)
 
 instance Encoding PushProvider where
   smpEncode = \case
-    PPApple -> "A"
+    PPApns -> "A"
   smpP =
     A.anyChar >>= \case
-      'A' -> pure PPApple
+      'A' -> pure PPApns
       _ -> fail "bad PushProvider"
 
 instance TextEncoding PushProvider where
   textEncode = \case
-    PPApple -> "apple"
+    PPApns -> "apple"
   textDecode = \case
-    "apple" -> Just PPApple
+    "apple" -> Just PPApns
     _ -> Nothing
 
 instance FromField PushProvider where fromField = fromTextField_ textDecode
@@ -363,7 +377,7 @@ instance Encoding NtfSubStatus where
       "ACTIVE" -> pure NSActive
       "END" -> pure NSEnd
       "SMP_AUTH" -> pure NSSMPAuth
-      _ -> fail "bad NtfError"
+      _ -> fail "bad NtfSubStatus"
 
 data NtfTknStatus
   = -- | Token created in DB
@@ -380,26 +394,27 @@ data NtfTknStatus
     NTExpired
   deriving (Eq, Show)
 
-instance TextEncoding NtfTknStatus where
-  textEncode = \case
-    NTNew -> "new"
-    NTRegistered -> "registered"
-    NTInvalid -> "invalid"
-    NTConfirmed -> "confirmed"
-    NTActive -> "active"
-    NTExpired -> "expired"
-  textDecode = \case
-    "new" -> Just NTNew
-    "registered" -> Just NTRegistered
-    "invalid" -> Just NTInvalid
-    "confirmed" -> Just NTConfirmed
-    "active" -> Just NTActive
-    "expired" -> Just NTExpired
-    _ -> Nothing
+instance Encoding NtfTknStatus where
+  smpEncode = \case
+    NTNew -> "NEW"
+    NTRegistered -> "REGISTERED"
+    NTInvalid -> "INVALID"
+    NTConfirmed -> "CONFIRMED"
+    NTActive -> "ACTIVE"
+    NTExpired -> "EXPIRED"
+  smpP =
+    A.takeTill (== ' ') >>= \case
+      "NEW" -> pure NTNew
+      "REGISTERED" -> pure NTRegistered
+      "INVALID" -> pure NTInvalid
+      "CONFIRMED" -> pure NTConfirmed
+      "ACTIVE" -> pure NTActive
+      "EXPIRED" -> pure NTExpired
+      _ -> fail "bad NtfTknStatus"
 
-instance FromField NtfTknStatus where fromField = fromTextField_ textDecode
+instance FromField NtfTknStatus where fromField = fromTextField_ $ either (const Nothing) Just . smpDecode . encodeUtf8
 
-instance ToField NtfTknStatus where toField = toField . textEncode
+instance ToField NtfTknStatus where toField = toField . decodeLatin1 . smpEncode
 
 checkEntity :: forall t e e'. (NtfEntityI e, NtfEntityI e') => t e' -> Either String (t e)
 checkEntity c = case testEquality (sNtfEntity @e) (sNtfEntity @e') of
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 942b2db42..5d81b3715 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -10,11 +10,13 @@
 
 module Simplex.Messaging.Notifications.Server where
 
+import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.Text as T
 import Network.Socket (ServiceName)
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
@@ -26,9 +28,12 @@ import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol (ErrorType (..), SignedTransmission, Transmission, encodeTransmission, tGet, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport (..), THandle (..), TProxy, Transport)
 import Simplex.Messaging.Transport.Server (runTransportServer)
 import Simplex.Messaging.Util
+import UnliftIO (async, uninterruptibleCancel)
+import UnliftIO.Concurrent (threadDelay)
 import UnliftIO.Exception
 import UnliftIO.STM
 
@@ -106,7 +111,7 @@ ntfSubscriber NtfSubscriber {subQ, smpAgent = ca@SMPClientAgent {msgQ, agentQ}}
 ntfPush :: MonadUnliftIO m => NtfPushServer -> m ()
 ntfPush s@NtfPushServer {pushQ} = liftIO . forever . runExceptT $ do
   (tkn@NtfTknData {token = DeviceToken pp _, tknStatus}, ntf) <- atomically (readTBQueue pushQ)
-  liftIO $ putStrLn $ "sending push notification to " <> show pp
+  logDebug $ "sending push notification to " <> T.pack (show pp)
   status <- readTVarIO tknStatus
   case (status, ntf) of
     (_, PNVerification _) -> do
@@ -116,13 +121,13 @@ ntfPush s@NtfPushServer {pushQ} = liftIO . forever . runExceptT $ do
     (NTActive, PNCheckMessages) -> do
       deliverNotification pp tkn ntf
     _ -> do
-      liftIO $ putStrLn "bad notification token status"
+      logError "bad notification token status"
   where
     deliverNotification :: PushProvider -> PushProviderClient
     deliverNotification pp tkn ntf = do
       deliver <- liftIO $ getPushClient s pp
       -- TODO retry later based on the error
-      deliver tkn ntf `catchError` \e -> liftIO (putStrLn $ "Push provider error (" <> show pp <> "): " <> show e) >> throwError e
+      deliver tkn ntf `catchError` \e -> logError (T.pack $ "Push provider error (" <> show pp <> "): " <> show e) >> throwError e
 
 runNtfClientTransport :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> m ()
 runNtfClientTransport th@THandle {sessionId} = do
@@ -138,14 +143,14 @@ clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connecte
 
 receive :: (Transport c, MonadUnliftIO m, MonadReader NtfEnv m) => THandle c -> NtfServerClient -> m ()
 receive th NtfServerClient {rcvQ, sndQ} = forever $ do
-  t@(_, _, (corrId, subId, cmdOrError)) <- tGet th
-  liftIO $ putStrLn "receive"
+  t@(_, _, (corrId, entId, cmdOrError)) <- tGet th
+  logDebug "received transmission"
   case cmdOrError of
-    Left e -> write sndQ (corrId, subId, NRErr e)
+    Left e -> write sndQ (corrId, entId, NRErr e)
     Right cmd ->
       verifyNtfTransmission t cmd >>= \case
         VRVerified req -> write rcvQ req
-        VRFailed -> write sndQ (corrId, subId, NRErr AUTH)
+        VRFailed -> write sndQ (corrId, entId, NRErr AUTH)
   where
     write q t = atomically $ writeTBQueue q t
 
@@ -159,41 +164,31 @@ data VerificationResult = VRVerified NtfRequest | VRFailed
 verifyNtfTransmission ::
   forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => SignedTransmission NtfCmd -> NtfCmd -> m VerificationResult
 verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do
+  st <- asks store
   case cmd of
-    NtfCmd SToken (TNEW n@(NewNtfTkn _ k _)) ->
-      -- TODO check that token is not already in store, if it is - verify that the saved key is the same
+    NtfCmd SToken c@(TNEW n@(NewNtfTkn _ k _)) -> do
+      r_ <- atomically $ getNtfToken st entId
       pure $
         if verifyCmdSignature sig_ signed k
-          then VRVerified (NtfReqNew corrId (ANE SToken n))
+          then case r_ of
+            Just r@(NtfTkn NtfTknData {tknVerifyKey})
+              | k == tknVerifyKey -> tknCmd r c
+              | otherwise -> VRFailed
+            _ -> VRVerified (NtfReqNew corrId (ANE SToken n))
           else VRFailed
     NtfCmd SToken c -> do
-      st <- asks store
-      atomically (getNtfToken st entId) >>= \case
-        Just r@(NtfTkn NtfTknData {tknVerifyKey}) ->
-          pure $
-            if verifyCmdSignature sig_ signed tknVerifyKey
-              then VRVerified (NtfReqCmd SToken r (corrId, entId, c))
-              else VRFailed
-        _ -> pure VRFailed -- TODO dummy verification
+      r_ <- atomically $ getNtfToken st entId
+      pure $ case r_ of
+        Just r@(NtfTkn NtfTknData {tknVerifyKey})
+          | verifyCmdSignature sig_ signed tknVerifyKey -> tknCmd r c
+          | otherwise -> VRFailed
+        _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` VRFailed
     _ -> pure VRFailed
-
--- do
---   st <- asks store
---   case cmd of
---     NCSubCreate tokenId smpQueue -> verifyCreateCmd verifyKey newSub <$> atomically (getNtfSubViaSMPQueue st smpQueue)
---     _ -> verifySubCmd <$> atomically (getNtfSub st subId)
---   where
---     verifyCreateCmd k newSub sub_
---       | verifyCmdSignature sig_ signed k = case sub_ of
---         Just sub -> if k == subVerifyKey sub then VRCommand sub else VRFail
---         _ -> VRCreate newSub
---       | otherwise = VRFail
---     verifySubCmd = \case
---       Just sub -> if verifyCmdSignature sig_ signed $ subVerifyKey sub then VRCommand sub else VRFail
---       _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` VRFail
+  where
+    tknCmd r c = VRVerified (NtfReqCmd SToken r (corrId, entId, c))
 
 client :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfServerClient -> NtfSubscriber -> NtfPushServer -> m ()
-client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {pushQ} =
+client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {pushQ, intervalNotifiers} =
   forever $
     atomically (readTBQueue rcvQ)
       >>= processCommand
@@ -202,30 +197,68 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {push
     processCommand :: NtfRequest -> m (Transmission NtfResponse)
     processCommand = \case
       NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn _ _ dhPubKey)) -> do
-        liftIO $ putStrLn "TNEW"
+        logDebug "TNEW - new token"
         st <- asks store
-        (srvDhPubKey, srvDrivDhKey) <- liftIO C.generateKeyPair'
-        let dhSecret = C.dh' dhPubKey srvDrivDhKey
+        ks@(srvDhPubKey, srvDhPrivKey) <- liftIO C.generateKeyPair'
+        let dhSecret = C.dh' dhPubKey srvDhPrivKey
         tknId <- getId
         regCode <- getRegCode
         atomically $ do
-          tkn <- mkNtfTknData newTkn dhSecret regCode
+          tkn <- mkNtfTknData newTkn ks dhSecret regCode
           addNtfToken st tknId tkn
           writeTBQueue pushQ (tkn, PNVerification regCode)
         pure (corrId, "", NRId tknId srvDhPubKey)
-      NtfReqCmd SToken (NtfTkn NtfTknData {tknStatus, tknRegCode}) (corrId, tknId, cmd) -> do
+      NtfReqCmd SToken (NtfTkn tkn@NtfTknData {tknStatus, tknRegCode, tknDhSecret, tknDhKeys = (srvDhPubKey, srvDhPrivKey)}) (corrId, tknId, cmd) -> do
         status <- readTVarIO tknStatus
         (corrId,tknId,) <$> case cmd of
-          TNEW _newTkn -> do
-            liftIO $ putStrLn "TNEW'"
-            pure NROk -- TODO when duplicate token sent
+          TNEW (NewNtfTkn _ _ dhPubKey) -> do
+            logDebug "TNEW - registered token"
+            let dhSecret = C.dh' dhPubKey srvDhPrivKey
+            -- it is required that DH secret is the same, to avoid failed verifications if notification is delaying
+            if tknDhSecret == dhSecret
+              then do
+                atomically $ writeTBQueue pushQ (tkn, PNVerification tknRegCode)
+                pure $ NRId tknId srvDhPubKey
+              else pure $ NRErr AUTH
           TVFY code -- this allows repeated verification for cases when client connection dropped before server response
             | (status == NTRegistered || status == NTConfirmed || status == NTActive) && tknRegCode == code -> do
+              logDebug "TVFY - token verified"
               atomically $ writeTVar tknStatus NTActive
               pure NROk
-            | otherwise -> pure $ NRErr AUTH
-          TDEL -> pure NROk
-          TCRN _int -> pure NROk
+            | otherwise -> do
+              logDebug "TVFY - incorrect code or token status"
+              pure $ NRErr AUTH
+          TCHK -> pure $ NRTkn status
+          TDEL -> do
+            logDebug "TDEL"
+            st <- asks store
+            atomically $ deleteNtfToken st tknId
+            pure NROk
+          TCRN 0 ->
+            logDebug "TCRN 0"
+              >> atomically (TM.lookupDelete tknId intervalNotifiers)
+              >>= mapM_ (uninterruptibleCancel . action)
+              >> pure NROk
+          TCRN int
+            | int < 20 -> pure $ NRErr QUOTA
+            | otherwise -> do
+              logDebug "TCRN"
+              atomically (TM.lookup tknId intervalNotifiers) >>= \case
+                Nothing -> runIntervalNotifier int
+                Just IntervalNotifier {interval, action} ->
+                  unless (interval == int) $ do
+                    uninterruptibleCancel action
+                    runIntervalNotifier int
+              pure NROk
+            where
+              runIntervalNotifier interval = do
+                action <- async . intervalNotifier $ fromIntegral interval * 1000000 * 60
+                let notifier = IntervalNotifier {action, token = tkn, interval}
+                atomically $ TM.insert tknId notifier intervalNotifiers
+                where
+                  intervalNotifier delay = forever $ do
+                    threadDelay delay
+                    atomically $ writeTBQueue pushQ (tkn, PNCheckMessages)
       NtfReqNew corrId (ANE SSubscription _newSub) -> pure (corrId, "", NROk)
       NtfReqCmd SSubscription _sub (corrId, subId, cmd) ->
         (corrId,subId,) <$> case cmd of
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 67b83f1af..9c94c5ace 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -7,9 +7,11 @@
 
 module Simplex.Messaging.Notifications.Server.Env where
 
+import Control.Concurrent.Async (Async)
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
+import Data.Word (Word16)
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket
 import qualified Network.TLS as T
@@ -59,7 +61,7 @@ newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsCo
   subscriber <- atomically $ newNtfSubscriber subQSize smpAgentCfg
   pushServer <- atomically $ newNtfPushServer pushQSize apnsConfig
   -- TODO not creating APNS client on start to pass CI test, has to be replaced with mock APNS server
-  -- void . liftIO $ newPushClient pushServer PPApple
+  -- void . liftIO $ newPushClient pushServer PPApns
   tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
   Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
   pure NtfEnv {config, subscriber, pushServer, store, idsDrg, tlsServerParams, serverIdentity = C.KeyHash fp}
@@ -78,20 +80,28 @@ newNtfSubscriber qSize smpAgentCfg = do
 data NtfPushServer = NtfPushServer
   { pushQ :: TBQueue (NtfTknData, PushNotification),
     pushClients :: TMap PushProvider PushProviderClient,
+    intervalNotifiers :: TMap NtfTokenId IntervalNotifier,
     apnsConfig :: APNSPushClientConfig
   }
 
+data IntervalNotifier = IntervalNotifier
+  { action :: Async (),
+    token :: NtfTknData,
+    interval :: Word16
+  }
+
 newNtfPushServer :: Natural -> APNSPushClientConfig -> STM NtfPushServer
 newNtfPushServer qSize apnsConfig = do
   pushQ <- newTBQueue qSize
   pushClients <- TM.empty
-  pure NtfPushServer {pushQ, pushClients, apnsConfig}
+  intervalNotifiers <- TM.empty
+  pure NtfPushServer {pushQ, pushClients, intervalNotifiers, apnsConfig}
 
 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 newPushClient NtfPushServer {apnsConfig, pushClients} = \case
-  PPApple -> do
+  PPApns -> do
     c <- apnsPushProviderClient <$> createAPNSPushClient apnsConfig
-    atomically $ TM.insert PPApple c pushClients
+    atomically $ TM.insert PPApns c pushClients
     pure c
 
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 8a67f9fcf..0143fd20b 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -1,12 +1,16 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use newtype instead of data" #-}
 
 module Simplex.Messaging.Notifications.Server.Push.APNS where
 
+import Control.Logger.Simple
 import Control.Monad.Except
 import Crypto.Hash.Algorithms (SHA256 (..))
 import qualified Crypto.PubKey.ECC.ECDSA as EC
@@ -20,6 +24,7 @@ import Data.Aeson (FromJSON, ToJSON, (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import Data.Bifunctor (first)
+import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
@@ -27,7 +32,6 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import qualified Data.CaseInsensitive as CI
 import Data.Int (Int64)
 import Data.Map.Strict (Map)
-import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
@@ -226,7 +230,7 @@ getApnsJWTToken APNSPushClient {apnsCfg = APNSPushClientConfig {appTeamId, token
       atomically $ writeTVar jwtToken t
       pure signedJWT'
   where
-    jwtTokenAge (JWTToken _ JWTClaims {iat}) = (iat -) . systemSeconds <$> getSystemTime
+    jwtTokenAge (JWTToken _ JWTClaims {iat}) = subtract iat . systemSeconds <$> getSystemTime
 
 mkApnsJWTToken :: Text -> JWTHeader -> EC.PrivateKey -> IO (JWTToken, SignedJWTToken)
 mkApnsJWTToken appTeamId jwtHeader privateKey = do
@@ -256,15 +260,15 @@ apnsNotification :: NtfTknData -> C.CbNonce -> Int -> PushNotification -> Either
 apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
   PNVerification (NtfRegCode code) ->
     encrypt code $ \code' ->
-      apn APNSBackground {contentAvailable = 1} . Just $ J.object ["verification" .= code']
+      apn APNSBackground {contentAvailable = 1} . Just $ J.object ["verification" .= code', "nonce" .= nonce]
   PNMessage srv nId ->
     encrypt (strEncode srv <> "/" <> strEncode nId) $ \ntfQueue ->
-      apn apnMutableContent . Just $ J.object ["checkMessage" .= ntfQueue]
+      apn apnMutableContent . Just $ J.object ["checkMessage" .= ntfQueue, "nonce" .= nonce]
   PNAlert text -> Right $ apn (apnAlert $ APNSAlertText text) Nothing
   PNCheckMessages -> Right $ apn APNSBackground {contentAvailable = 1} . Just $ J.object ["checkMessages" .= True]
   where
     encrypt :: ByteString -> (Text -> APNSNotification) -> Either C.CryptoError APNSNotification
-    encrypt ntfData f = f . safeDecodeUtf8 . U.encode <$> C.cbEncrypt tknDhSecret nonce ntfData paddedLen
+    encrypt ntfData f = f . safeDecodeUtf8 . B64.encode <$> C.cbEncrypt tknDhSecret nonce ntfData paddedLen
     apn aps notificationData = APNSNotification {aps, notificationData}
     apnMutableContent = APNSMutableContent {mutableContent = 1, alert = APNSAlertText "Encrypted message or some other app event", category = Nothing}
     apnAlert alert = APNSAlert {alert, badge = Nothing, sound = Nothing, category = Nothing}
@@ -300,40 +304,39 @@ data PushProviderError
 
 type PushProviderClient = NtfTknData -> PushNotification -> ExceptT PushProviderError IO ()
 
-newtype APNSErrorReponse = APNSErrorReponse {reason :: Text}
+-- this is not a newtype on purpose to have a correct JSON encoding as a record
+data APNSErrorReponse = APNSErrorReponse {reason :: Text}
   deriving (Generic, FromJSON)
 
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
-apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {token = DeviceToken PPApple tknStr} pn = do
+apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {token = DeviceToken PPApns tknStr} pn = do
   http2 <- liftHTTPS2 $ getApnsHTTP2Client c
   nonce <- atomically $ C.pseudoRandomCbNonce nonceDrg
   apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
-  liftIO $ putStrLn $ "APNS notification: " <> show apnsNtf
   req <- liftIO $ apnsRequest c tknStr apnsNtf
-  liftIO $ putStrLn $ "APNS request: " <> show req
   HTTP2Response {response, respBody} <- liftHTTPS2 $ sendRequest http2 req
   let status = H.responseStatus response
-      reason = fromMaybe "" $ J.decodeStrict' =<< respBody
-  liftIO $ putStrLn $ "APNS response: " <> show status <> " " <> T.unpack reason
-  result status reason
+      reason' = maybe "?" reason $ J.decodeStrict' respBody
+  logDebug $ "APNS response: " <> T.pack (show status) <> " " <> reason'
+  result status reason'
   where
     result :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
-    result status reason
+    result status reason'
       | status == Just N.ok200 = pure ()
       | status == Just N.badRequest400 =
-        case reason of
+        case reason' of
           "BadDeviceToken" -> throwError PPTokenInvalid
           "DeviceTokenNotForTopic" -> throwError PPTokenInvalid
           "TopicDisallowed" -> throwError PPPermanentError
-          _ -> err status reason
-      | status == Just N.forbidden403 = case reason of
+          _ -> err status reason'
+      | status == Just N.forbidden403 = case reason' of
         "ExpiredProviderToken" -> throwError PPPermanentError -- there should be no point retrying it as the token was refreshed
         "InvalidProviderToken" -> throwError PPPermanentError
-        _ -> err status reason
+        _ -> err status reason'
       | status == Just N.gone410 = throwError PPTokenInvalid
       | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwError PPRetryLater
       -- Just tooManyRequests429 -> TODO TooManyRequests - too many requests for the same token
-      | otherwise = err status reason
+      | otherwise = err status reason'
     err :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
     err s r = throwError $ PPResponseError s r
     liftHTTPS2 a = ExceptT $ first PPConnection <$> a
diff --git a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
index 366ba26c2..9123a690f 100644
--- a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
@@ -28,14 +28,15 @@ data NtfTknData = NtfTknData
   { token :: DeviceToken,
     tknStatus :: TVar NtfTknStatus,
     tknVerifyKey :: C.APublicVerifyKey,
+    tknDhKeys :: C.KeyPair 'C.X25519,
     tknDhSecret :: C.DhSecretX25519,
     tknRegCode :: NtfRegCode
   }
 
-mkNtfTknData :: NewNtfEntity 'Token -> C.DhSecretX25519 -> NtfRegCode -> STM NtfTknData
-mkNtfTknData (NewNtfTkn token tknVerifyKey _) tknDhSecret tknRegCode = do
+mkNtfTknData :: NewNtfEntity 'Token -> C.KeyPair 'C.X25519 -> C.DhSecretX25519 -> NtfRegCode -> STM NtfTknData
+mkNtfTknData (NewNtfTkn token tknVerifyKey _) tknDhKeys tknDhSecret tknRegCode = do
   tknStatus <- newTVar NTRegistered
-  pure NtfTknData {token, tknStatus, tknVerifyKey, tknDhSecret, tknRegCode}
+  pure NtfTknData {token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode}
 
 -- data NtfSubscriptionsStore = NtfSubscriptionsStore
 
@@ -64,8 +65,12 @@ getNtfToken st tknId = NtfTkn <$$> TM.lookup tknId (tokens st)
 
 addNtfToken :: NtfStore -> NtfTokenId -> NtfTknData -> STM ()
 addNtfToken st tknId tkn@NtfTknData {token} = do
-  TM.insert tknId tkn (tokens st)
-  TM.insert token tknId (tokenIds st)
+  TM.insert tknId tkn $ tokens st
+  TM.insert token tknId $ tokenIds st
+
+deleteNtfToken :: NtfStore -> NtfTokenId -> STM ()
+deleteNtfToken st tknId = do
+  TM.lookupDelete tknId (tokens st) >>= mapM_ (\NtfTknData {token} -> TM.delete token $ tokenIds st)
 
 -- getNtfRec :: NtfStore -> SNtfEntity e -> NtfEntityId -> STM (Maybe (NtfEntityRec e))
 -- getNtfRec st ent entId = case ent of
diff --git a/src/Simplex/Messaging/Transport/Client/HTTP2.hs b/src/Simplex/Messaging/Transport/Client/HTTP2.hs
index 8e3a35741..2d019abd3 100644
--- a/src/Simplex/Messaging/Transport/Client/HTTP2.hs
+++ b/src/Simplex/Messaging/Transport/Client/HTTP2.hs
@@ -9,11 +9,13 @@ module Simplex.Messaging.Transport.Client.HTTP2 where
 import Control.Concurrent.Async
 import Control.Exception (IOException, catch, finally)
 import qualified Control.Exception as E
+import Control.Logger.Simple (logDebug)
 import Control.Monad.Except
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Default (def)
 import Data.Maybe (isNothing)
+import qualified Data.Text as T
 import qualified Data.X509.CertificateStore as XS
 import Foreign (mallocBytes)
 import Network.HPACK (BufferSize, HeaderTable)
@@ -41,13 +43,12 @@ data HTTPS2Client = HTTPS2Client
 
 data HTTP2Response = HTTP2Response
   { response :: Response,
-    respBody :: Maybe ByteString,
+    respBody :: ByteString,
     respTrailers :: Maybe HeaderTable
   }
 
 data HTTP2SClientConfig = HTTP2SClientConfig
   { qSize :: Natural,
-    maxBody :: Int,
     connTimeout :: Int,
     tcpKeepAlive :: Maybe KeepAliveOpts,
     caStoreFile :: FilePath,
@@ -59,8 +60,7 @@ defaultHTTP2SClientConfig :: HTTP2SClientConfig
 defaultHTTP2SClientConfig =
   HTTP2SClientConfig
     { qSize = 64,
-      maxBody = 500000,
-      connTimeout = 5000000,
+      connTimeout = 10000000,
       tcpKeepAlive = Nothing,
       caStoreFile = "/etc/ssl/cert.pem",
       suportedTLSParams =
@@ -112,24 +112,14 @@ getHTTPS2Client host port config@HTTP2SClientConfig {tcpKeepAlive, connTimeout,
       (req, respVar) <- atomically $ readTBQueue reqQ
       sendReq req $ \r -> do
         let writeResp respBody respTrailers = atomically $ putTMVar respVar HTTP2Response {response = r, respBody, respTrailers}
-        case H.responseBodySize r of
-          Just sz ->
-            if sz <= maxBody config
-              then do
-                respBody <- getResponseBody r "" sz
-                respTrailers <- join <$> mapM (const $ H.getResponseTrailers r) respBody
-                writeResp respBody respTrailers
-              else writeResp Nothing Nothing
-          _ -> writeResp Nothing Nothing
+        respBody <- getResponseBody r ""
+        respTrailers <- H.getResponseTrailers r
+        writeResp respBody respTrailers
 
-    getResponseBody :: Response -> ByteString -> Int -> IO (Maybe ByteString)
-    getResponseBody r s sz =
-      H.getResponseBodyChunk r >>= \chunk -> do
-        if chunk == ""
-          then pure (if B.length s == sz then Just s else Nothing)
-          else do
-            let s' = s <> chunk
-            if B.length s' > sz then pure Nothing else getResponseBody r s' sz
+    getResponseBody :: Response -> ByteString -> IO ByteString
+    getResponseBody r s =
+      H.getResponseBodyChunk r >>= \chunk ->
+        if B.null chunk then pure s else getResponseBody r $ s <> chunk
 
 -- | Disconnects client from the server and terminates client threads.
 closeHTTPS2Client :: HTTPS2Client -> IO ()
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index a37bcff19..a08e72623 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -15,7 +15,7 @@ import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (DeviceToken), PushProvider (PPApple))
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), PushProvider (..))
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..))
 import System.Timeout
@@ -194,7 +194,7 @@ testNotificationToken :: IO ()
 testNotificationToken = do
   alice <- getSMPAgentClient cfg initAgentServers
   Right () <- runExceptT $ do
-    registerNtfToken alice $ DeviceToken PPApple "abcd"
+    registerNtfToken alice $ DeviceToken PPApns "abcd"
   pure ()
 
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()

From 17888f89a904db008ff3a1e8839acea1213c55de Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 18 Apr 2022 08:57:55 +0100
Subject: [PATCH 08/12] test notification token with agent and notifications
 server (#353)

* test notification token with agent and notifications server

* notification server test with APNS mock

* set environment variables in the test

* use base64url encoding in encrypted notification data
---
 simplexmq.cabal                               |   5 +-
 .../Messaging/Notifications/Server/Env.hs     |   3 +-
 .../Notifications/Server/Push/APNS.hs         |  44 +++--
 .../Messaging/Transport/Client/HTTP2.hs       | 159 ------------------
 src/Simplex/Messaging/Transport/HTTP2.hs      |  36 ++++
 .../Messaging/Transport/HTTP2/Client.hs       | 128 ++++++++++++++
 .../Messaging/Transport/HTTP2/Server.hs       |  70 ++++++++
 src/Simplex/Messaging/Transport/Server.hs     |   8 +-
 tests/AgentTests/FunctionalAPITests.hs        |  44 ++---
 tests/AgentTests/NotificationTests.hs         |  49 ++++++
 tests/NtfClient.hs                            | 107 ++++++++++--
 tests/NtfServerTests.hs                       |   2 +-
 tests/SMPAgentClient.hs                       |  12 +-
 tests/Test.hs                                 |   8 +-
 tests/fixtures/AuthKey_H82WD9K9AQ.p8          |   6 +
 15 files changed, 451 insertions(+), 230 deletions(-)
 delete mode 100644 src/Simplex/Messaging/Transport/Client/HTTP2.hs
 create mode 100644 src/Simplex/Messaging/Transport/HTTP2.hs
 create mode 100644 src/Simplex/Messaging/Transport/HTTP2/Client.hs
 create mode 100644 src/Simplex/Messaging/Transport/HTTP2/Server.hs
 create mode 100644 tests/AgentTests/NotificationTests.hs
 create mode 100644 tests/fixtures/AuthKey_H82WD9K9AQ.p8

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 6a64f8214..1472db2f4 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -74,7 +74,9 @@ library
       Simplex.Messaging.TMap
       Simplex.Messaging.Transport
       Simplex.Messaging.Transport.Client
-      Simplex.Messaging.Transport.Client.HTTP2
+      Simplex.Messaging.Transport.HTTP2
+      Simplex.Messaging.Transport.HTTP2.Client
+      Simplex.Messaging.Transport.HTTP2.Server
       Simplex.Messaging.Transport.KeepAlive
       Simplex.Messaging.Transport.Server
       Simplex.Messaging.Transport.WebSockets
@@ -325,6 +327,7 @@ test-suite smp-server-test
       AgentTests.ConnectionRequestTests
       AgentTests.DoubleRatchetTests
       AgentTests.FunctionalAPITests
+      AgentTests.NotificationTests
       AgentTests.SQLiteTests
       CoreTests.EncodingTests
       CoreTests.ProtocolErrorTests
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 9c94c5ace..ce00ab354 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -8,6 +8,7 @@
 module Simplex.Messaging.Notifications.Server.Env where
 
 import Control.Concurrent.Async (Async)
+import Control.Monad (void)
 import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
@@ -61,7 +62,7 @@ newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsCo
   subscriber <- atomically $ newNtfSubscriber subQSize smpAgentCfg
   pushServer <- atomically $ newNtfPushServer pushQSize apnsConfig
   -- TODO not creating APNS client on start to pass CI test, has to be replaced with mock APNS server
-  -- void . liftIO $ newPushClient pushServer PPApns
+  void . liftIO $ newPushClient pushServer PPApns
   tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
   Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
   pure NtfEnv {config, subscriber, pushServer, store, idsDrg, tlsServerParams, serverIdentity = C.KeyHash fp}
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 0143fd20b..2f826e469 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -24,7 +24,6 @@ import Data.Aeson (FromJSON, ToJSON, (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import Data.Bifunctor (first)
-import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
@@ -37,8 +36,8 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Time.Clock.System
 import qualified Data.X509 as X
-import GHC.Generics
-import Network.HTTP.Types (HeaderName, Status, hAuthorization, methodPost)
+import GHC.Generics (Generic)
+import Network.HTTP.Types (HeaderName, Status)
 import qualified Network.HTTP.Types as N
 import Network.HTTP2.Client (Request)
 import qualified Network.HTTP2.Client as H
@@ -48,7 +47,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Subscriptions (NtfTknData (..))
 import Simplex.Messaging.Protocol (NotifierId, SMPServer)
-import Simplex.Messaging.Transport.Client.HTTP2
+import Simplex.Messaging.Transport.HTTP2.Client
 import System.Environment (getEnv)
 import UnliftIO.STM
 
@@ -177,9 +176,9 @@ data APNSPushClientConfig = APNSPushClientConfig
     paddedNtfLength :: Int,
     appName :: ByteString,
     appTeamId :: Text,
-    apnHost :: HostName,
-    apnPort :: ServiceName,
-    https2cfg :: HTTP2SClientConfig
+    apnsHost :: HostName,
+    apnsPort :: ServiceName,
+    http2cfg :: HTTP2ClientConfig
   }
   deriving (Show)
 
@@ -193,13 +192,13 @@ defaultAPNSPushClientConfig =
       paddedNtfLength = 256,
       appName = "chat.simplex.app",
       appTeamId = "5NN7GUYB6T",
-      apnHost = "api.sandbox.push.apple.com",
-      apnPort = "443",
-      https2cfg = defaultHTTP2SClientConfig
+      apnsHost = "api.sandbox.push.apple.com",
+      apnsPort = "443",
+      http2cfg = defaultHTTP2ClientConfig
     }
 
 data APNSPushClient = APNSPushClient
-  { https2Client :: TVar (Maybe HTTPS2Client),
+  { https2Client :: TVar (Maybe HTTP2Client),
     privateKey :: EC.PrivateKey,
     jwtHeader :: JWTHeader,
     jwtToken :: TVar (JWTToken, SignedJWTToken),
@@ -213,7 +212,6 @@ createAPNSPushClient apnsCfg@APNSPushClientConfig {authKeyFileEnv, authKeyAlg, a
   void $ connectHTTPS2 apnsCfg https2Client
   privateKey <- readECPrivateKey =<< getEnv authKeyFileEnv
   authKeyId <- T.pack <$> getEnv authKeyIdEnv
-  putStrLn $ authKeyIdEnv <> "=" <> T.unpack authKeyId
   let jwtHeader = JWTHeader {alg = authKeyAlg, kid = authKeyId}
   jwtToken <- newTVarIO =<< mkApnsJWTToken appTeamId jwtHeader privateKey
   nonceDrg <- drgNew >>= newTVarIO
@@ -238,9 +236,9 @@ mkApnsJWTToken appTeamId jwtHeader privateKey = do
   signedJWT <- signedJWTToken privateKey jwt
   pure (jwt, signedJWT)
 
-connectHTTPS2 :: APNSPushClientConfig -> TVar (Maybe HTTPS2Client) -> IO (Either HTTPS2ClientError HTTPS2Client)
-connectHTTPS2 APNSPushClientConfig {apnHost, apnPort, https2cfg} https2Client = do
-  r <- getHTTPS2Client apnHost apnPort https2cfg disconnected
+connectHTTPS2 :: APNSPushClientConfig -> TVar (Maybe HTTP2Client) -> IO (Either HTTP2ClientError HTTP2Client)
+connectHTTPS2 APNSPushClientConfig {apnsHost, apnsPort, http2cfg} https2Client = do
+  r <- getHTTP2Client apnsHost apnsPort http2cfg disconnected
   case r of
     Right client -> atomically . writeTVar https2Client $ Just client
     Left e -> putStrLn $ "Error connecting to APNS: " <> show e
@@ -248,13 +246,13 @@ connectHTTPS2 APNSPushClientConfig {apnHost, apnPort, https2cfg} https2Client =
   where
     disconnected = atomically $ writeTVar https2Client Nothing
 
-getApnsHTTP2Client :: APNSPushClient -> IO (Either HTTPS2ClientError HTTPS2Client)
+getApnsHTTP2Client :: APNSPushClient -> IO (Either HTTP2ClientError HTTP2Client)
 getApnsHTTP2Client APNSPushClient {https2Client, apnsCfg} =
   readTVarIO https2Client >>= maybe (connectHTTPS2 apnsCfg https2Client) (pure . Right)
 
 disconnectApnsHTTP2Client :: APNSPushClient -> IO ()
 disconnectApnsHTTP2Client APNSPushClient {https2Client} =
-  readTVarIO https2Client >>= mapM_ closeHTTPS2Client >> atomically (writeTVar https2Client Nothing)
+  readTVarIO https2Client >>= mapM_ closeHTTP2Client >> atomically (writeTVar https2Client Nothing)
 
 apnsNotification :: NtfTknData -> C.CbNonce -> Int -> PushNotification -> Either C.CryptoError APNSNotification
 apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
@@ -268,7 +266,7 @@ apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
   PNCheckMessages -> Right $ apn APNSBackground {contentAvailable = 1} . Just $ J.object ["checkMessages" .= True]
   where
     encrypt :: ByteString -> (Text -> APNSNotification) -> Either C.CryptoError APNSNotification
-    encrypt ntfData f = f . safeDecodeUtf8 . B64.encode <$> C.cbEncrypt tknDhSecret nonce ntfData paddedLen
+    encrypt ntfData f = f . safeDecodeUtf8 . U.encode <$> C.cbEncrypt tknDhSecret nonce ntfData paddedLen
     apn aps notificationData = APNSNotification {aps, notificationData}
     apnMutableContent = APNSMutableContent {mutableContent = 1, alert = APNSAlertText "Encrypted message or some other app event", category = Nothing}
     apnAlert alert = APNSAlert {alert, badge = Nothing, sound = Nothing, category = Nothing}
@@ -277,13 +275,13 @@ apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case
 apnsRequest :: APNSPushClient -> ByteString -> APNSNotification -> IO Request
 apnsRequest c tkn ntf@APNSNotification {aps} = do
   signedJWT <- getApnsJWTToken c
-  pure $ H.requestBuilder methodPost path (headers signedJWT) (lazyByteString $ J.encode ntf)
+  pure $ H.requestBuilder N.methodPost path (headers signedJWT) (lazyByteString $ J.encode ntf)
   where
     path = "/3/device/" <> tkn
     headers signedJWT =
       [ (hApnsTopic, appName $ apnsCfg (c :: APNSPushClient)),
         (hApnsPushType, pushType aps),
-        (hAuthorization, "bearer " <> signedJWT)
+        (N.hAuthorization, "bearer " <> signedJWT)
       ]
         <> [(hApnsPriority, "5") | isBackground aps]
     isBackground = \case
@@ -294,7 +292,7 @@ apnsRequest c tkn ntf@APNSNotification {aps} = do
       _ -> "alert"
 
 data PushProviderError
-  = PPConnection HTTPS2ClientError
+  = PPConnection HTTP2ClientError
   | PPCryptoError C.CryptoError
   | PPResponseError (Maybe Status) Text
   | PPTokenInvalid
@@ -305,7 +303,7 @@ data PushProviderError
 type PushProviderClient = NtfTknData -> PushNotification -> ExceptT PushProviderError IO ()
 
 -- this is not a newtype on purpose to have a correct JSON encoding as a record
-data APNSErrorReponse = APNSErrorReponse {reason :: Text}
+data APNSErrorResponse = APNSErrorResponse {reason :: Text}
   deriving (Generic, FromJSON)
 
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
@@ -316,7 +314,7 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
   req <- liftIO $ apnsRequest c tknStr apnsNtf
   HTTP2Response {response, respBody} <- liftHTTPS2 $ sendRequest http2 req
   let status = H.responseStatus response
-      reason' = maybe "?" reason $ J.decodeStrict' respBody
+      reason' = maybe "" reason $ J.decodeStrict' respBody
   logDebug $ "APNS response: " <> T.pack (show status) <> " " <> reason'
   result status reason'
   where
diff --git a/src/Simplex/Messaging/Transport/Client/HTTP2.hs b/src/Simplex/Messaging/Transport/Client/HTTP2.hs
deleted file mode 100644
index 2d019abd3..000000000
--- a/src/Simplex/Messaging/Transport/Client/HTTP2.hs
+++ /dev/null
@@ -1,159 +0,0 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Simplex.Messaging.Transport.Client.HTTP2 where
-
-import Control.Concurrent.Async
-import Control.Exception (IOException, catch, finally)
-import qualified Control.Exception as E
-import Control.Logger.Simple (logDebug)
-import Control.Monad.Except
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Data.Default (def)
-import Data.Maybe (isNothing)
-import qualified Data.Text as T
-import qualified Data.X509.CertificateStore as XS
-import Foreign (mallocBytes)
-import Network.HPACK (BufferSize, HeaderTable)
-import Network.HTTP2.Client (ClientConfig (..), Config (..), Request, Response)
-import qualified Network.HTTP2.Client as H
-import Network.Socket (HostName, ServiceName)
-import qualified Network.TLS as T
-import qualified Network.TLS.Extra as TE
-import Numeric.Natural (Natural)
-import Simplex.Messaging.Transport (TLS, Transport (cGet, cPut))
-import Simplex.Messaging.Transport.Client (runTLSTransportClient)
-import Simplex.Messaging.Transport.KeepAlive (KeepAliveOpts)
-import qualified System.TimeManager as TI
-import UnliftIO.STM
-import UnliftIO.Timeout
-
-data HTTPS2Client = HTTPS2Client
-  { action :: Async (),
-    connected :: TVar Bool,
-    host :: HostName,
-    port :: ServiceName,
-    config :: HTTP2SClientConfig,
-    reqQ :: TBQueue (Request, TMVar HTTP2Response)
-  }
-
-data HTTP2Response = HTTP2Response
-  { response :: Response,
-    respBody :: ByteString,
-    respTrailers :: Maybe HeaderTable
-  }
-
-data HTTP2SClientConfig = HTTP2SClientConfig
-  { qSize :: Natural,
-    connTimeout :: Int,
-    tcpKeepAlive :: Maybe KeepAliveOpts,
-    caStoreFile :: FilePath,
-    suportedTLSParams :: T.Supported
-  }
-  deriving (Show)
-
-defaultHTTP2SClientConfig :: HTTP2SClientConfig
-defaultHTTP2SClientConfig =
-  HTTP2SClientConfig
-    { qSize = 64,
-      connTimeout = 10000000,
-      tcpKeepAlive = Nothing,
-      caStoreFile = "/etc/ssl/cert.pem",
-      suportedTLSParams =
-        def
-          { T.supportedVersions = [T.TLS13, T.TLS12],
-            T.supportedCiphers = TE.ciphersuite_strong_det,
-            T.supportedSecureRenegotiation = False
-          }
-    }
-
-data HTTPS2ClientError = HCResponseTimeout | HCNetworkError | HCIOError IOException
-  deriving (Show)
-
-getHTTPS2Client :: HostName -> ServiceName -> HTTP2SClientConfig -> IO () -> IO (Either HTTPS2ClientError HTTPS2Client)
-getHTTPS2Client host port config@HTTP2SClientConfig {tcpKeepAlive, connTimeout, caStoreFile, suportedTLSParams} disconnected =
-  (atomically mkHTTPS2Client >>= runClient)
-    `catch` \(e :: IOException) -> pure . Left $ HCIOError e
-  where
-    mkHTTPS2Client :: STM HTTPS2Client
-    mkHTTPS2Client = do
-      connected <- newTVar False
-      reqQ <- newTBQueue $ qSize config
-      pure HTTPS2Client {action = undefined, connected, host, port, config, reqQ}
-
-    runClient :: HTTPS2Client -> IO (Either HTTPS2ClientError HTTPS2Client)
-    runClient c = do
-      cVar <- newEmptyTMVarIO
-      caStore <- XS.readCertificateStore caStoreFile
-      when (isNothing caStore) . putStrLn $ "Error loading CertificateStore from " <> caStoreFile
-      action <-
-        async $
-          runHTTPS2Client suportedTLSParams caStore host port tcpKeepAlive (client c cVar)
-            `finally` atomically (putTMVar cVar $ Left HCNetworkError)
-      conn_ <- connTimeout `timeout` atomically (takeTMVar cVar)
-      pure $ case conn_ of
-        Just (Right ()) -> Right c {action}
-        Just (Left e) -> Left e
-        Nothing -> Left HCNetworkError
-
-    client :: HTTPS2Client -> TMVar (Either HTTPS2ClientError ()) -> (Request -> (Response -> IO ()) -> IO ()) -> IO ()
-    client c cVar sendReq = do
-      atomically $ do
-        writeTVar (connected c) True
-        putTMVar cVar $ Right ()
-      process c sendReq `finally` disconnected
-
-    process :: HTTPS2Client -> (Request -> (Response -> IO ()) -> IO ()) -> IO ()
-    process HTTPS2Client {reqQ} sendReq = forever $ do
-      (req, respVar) <- atomically $ readTBQueue reqQ
-      sendReq req $ \r -> do
-        let writeResp respBody respTrailers = atomically $ putTMVar respVar HTTP2Response {response = r, respBody, respTrailers}
-        respBody <- getResponseBody r ""
-        respTrailers <- H.getResponseTrailers r
-        writeResp respBody respTrailers
-
-    getResponseBody :: Response -> ByteString -> IO ByteString
-    getResponseBody r s =
-      H.getResponseBodyChunk r >>= \chunk ->
-        if B.null chunk then pure s else getResponseBody r $ s <> chunk
-
--- | Disconnects client from the server and terminates client threads.
-closeHTTPS2Client :: HTTPS2Client -> IO ()
--- TODO disconnect
-closeHTTPS2Client = uninterruptibleCancel . action
-
-sendRequest :: HTTPS2Client -> Request -> IO (Either HTTPS2ClientError HTTP2Response)
-sendRequest HTTPS2Client {reqQ, config} req = do
-  resp <- newEmptyTMVarIO
-  atomically $ writeTBQueue reqQ (req, resp)
-  maybe (Left HCResponseTimeout) Right <$> (connTimeout config `timeout` atomically (takeTMVar resp))
-
-runHTTPS2Client :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe KeepAliveOpts -> ((Request -> (Response -> IO ()) -> IO ()) -> IO ()) -> IO ()
-runHTTPS2Client tlsParams caStore host port keepAliveOpts client =
-  runTLSTransportClient tlsParams caStore host port Nothing keepAliveOpts https2Client
-  where
-    cfg = ClientConfig "https" (B.pack host) 20
-    https2Client :: TLS -> IO ()
-    https2Client c =
-      E.bracket
-        (allocTlsConfig c 16384)
-        H.freeSimpleConfig
-        (\conf -> H.run cfg conf client)
-
-    allocTlsConfig :: TLS -> BufferSize -> IO Config
-    allocTlsConfig c sz = do
-      buf <- mallocBytes sz
-      tm <- TI.initialize $ 30 * 1000000
-      pure
-        Config
-          { confWriteBuffer = buf,
-            confBufferSize = sz,
-            confSendAll = cPut c,
-            confReadN = cGet c,
-            confPositionReadMaker = H.defaultPositionReadMaker,
-            confTimeoutManager = tm
-          }
diff --git a/src/Simplex/Messaging/Transport/HTTP2.hs b/src/Simplex/Messaging/Transport/HTTP2.hs
new file mode 100644
index 000000000..750a5c87f
--- /dev/null
+++ b/src/Simplex/Messaging/Transport/HTTP2.hs
@@ -0,0 +1,36 @@
+module Simplex.Messaging.Transport.HTTP2 where
+
+import qualified Control.Exception as E
+import Data.Default (def)
+import Foreign (mallocBytes)
+import Network.HPACK (BufferSize)
+import Network.HTTP2.Client (Config (..), defaultPositionReadMaker, freeSimpleConfig)
+import qualified Network.TLS as T
+import qualified Network.TLS.Extra as TE
+import Simplex.Messaging.Transport (TLS, Transport (cGet, cPut))
+import qualified System.TimeManager as TI
+
+withTlsConfig :: TLS -> BufferSize -> (Config -> IO ()) -> IO ()
+withTlsConfig c sz = E.bracket (allocTlsConfig c sz) freeSimpleConfig
+
+allocTlsConfig :: TLS -> BufferSize -> IO Config
+allocTlsConfig c sz = do
+  buf <- mallocBytes sz
+  tm <- TI.initialize $ 30 * 1000000
+  pure
+    Config
+      { confWriteBuffer = buf,
+        confBufferSize = sz,
+        confSendAll = cPut c,
+        confReadN = cGet c,
+        confPositionReadMaker = defaultPositionReadMaker,
+        confTimeoutManager = tm
+      }
+
+http2TLSParams :: T.Supported
+http2TLSParams =
+  def
+    { T.supportedVersions = [T.TLS13, T.TLS12],
+      T.supportedCiphers = TE.ciphersuite_strong_det,
+      T.supportedSecureRenegotiation = False
+    }
diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
new file mode 100644
index 000000000..a79368ad1
--- /dev/null
+++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Transport.HTTP2.Client where
+
+import Control.Concurrent.Async
+import Control.Exception (IOException)
+import qualified Control.Exception as E
+import Control.Monad.Except
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Maybe (isNothing)
+import qualified Data.X509.CertificateStore as XS
+import Network.HPACK (HeaderTable)
+import Network.HTTP2.Client (ClientConfig (..), Request, Response)
+import qualified Network.HTTP2.Client as H
+import Network.Socket (HostName, ServiceName)
+import qualified Network.TLS as T
+import Numeric.Natural (Natural)
+import Simplex.Messaging.Transport.Client (runTLSTransportClient)
+import Simplex.Messaging.Transport.HTTP2 (http2TLSParams, withTlsConfig)
+import Simplex.Messaging.Transport.KeepAlive (KeepAliveOpts)
+import UnliftIO.STM
+import UnliftIO.Timeout
+
+data HTTP2Client = HTTP2Client
+  { action :: Async (),
+    connected :: TVar Bool,
+    host :: HostName,
+    port :: ServiceName,
+    config :: HTTP2ClientConfig,
+    reqQ :: TBQueue (Request, TMVar HTTP2Response)
+  }
+
+data HTTP2Response = HTTP2Response
+  { response :: Response,
+    respBody :: ByteString,
+    respTrailers :: Maybe HeaderTable
+  }
+
+data HTTP2ClientConfig = HTTP2ClientConfig
+  { qSize :: Natural,
+    connTimeout :: Int,
+    tcpKeepAlive :: Maybe KeepAliveOpts,
+    caStoreFile :: FilePath,
+    suportedTLSParams :: T.Supported
+  }
+  deriving (Show)
+
+defaultHTTP2ClientConfig :: HTTP2ClientConfig
+defaultHTTP2ClientConfig =
+  HTTP2ClientConfig
+    { qSize = 64,
+      connTimeout = 10000000,
+      tcpKeepAlive = Nothing,
+      caStoreFile = "/etc/ssl/cert.pem",
+      suportedTLSParams = http2TLSParams
+    }
+
+data HTTP2ClientError = HCResponseTimeout | HCNetworkError | HCNetworkError1 | HCIOError IOException
+  deriving (Show)
+
+getHTTP2Client :: HostName -> ServiceName -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client)
+getHTTP2Client host port config@HTTP2ClientConfig {tcpKeepAlive, connTimeout, caStoreFile, suportedTLSParams} disconnected =
+  (atomically mkHTTPS2Client >>= runClient)
+    `E.catch` \(e :: IOException) -> pure . Left $ HCIOError e
+  where
+    mkHTTPS2Client :: STM HTTP2Client
+    mkHTTPS2Client = do
+      connected <- newTVar False
+      reqQ <- newTBQueue $ qSize config
+      pure HTTP2Client {action = undefined, connected, host, port, config, reqQ}
+
+    runClient :: HTTP2Client -> IO (Either HTTP2ClientError HTTP2Client)
+    runClient c = do
+      cVar <- newEmptyTMVarIO
+      caStore <- XS.readCertificateStore caStoreFile
+      when (isNothing caStore) . putStrLn $ "Error loading CertificateStore from " <> caStoreFile
+      action <-
+        async $
+          runHTTP2Client suportedTLSParams caStore host port tcpKeepAlive (client c cVar)
+            `E.finally` atomically (putTMVar cVar $ Left HCNetworkError)
+      conn_ <- connTimeout `timeout` atomically (takeTMVar cVar)
+      pure $ case conn_ of
+        Just (Right ()) -> Right c {action}
+        Just (Left e) -> Left e
+        Nothing -> Left HCNetworkError1
+
+    client :: HTTP2Client -> TMVar (Either HTTP2ClientError ()) -> (Request -> (Response -> IO ()) -> IO ()) -> IO ()
+    client c cVar sendReq = do
+      atomically $ do
+        writeTVar (connected c) True
+        putTMVar cVar $ Right ()
+      process c sendReq `E.finally` disconnected
+
+    process :: HTTP2Client -> (Request -> (Response -> IO ()) -> IO ()) -> IO ()
+    process HTTP2Client {reqQ} sendReq = forever $ do
+      (req, respVar) <- atomically $ readTBQueue reqQ
+      sendReq req $ \r -> do
+        let writeResp respBody respTrailers = atomically $ putTMVar respVar HTTP2Response {response = r, respBody, respTrailers}
+        respBody <- getResponseBody r ""
+        respTrailers <- H.getResponseTrailers r
+        writeResp respBody respTrailers
+
+    getResponseBody :: Response -> ByteString -> IO ByteString
+    getResponseBody r s =
+      H.getResponseBodyChunk r >>= \chunk ->
+        if B.null chunk then pure s else getResponseBody r $ s <> chunk
+
+-- | Disconnects client from the server and terminates client threads.
+closeHTTP2Client :: HTTP2Client -> IO ()
+-- TODO disconnect
+closeHTTP2Client = uninterruptibleCancel . action
+
+sendRequest :: HTTP2Client -> Request -> IO (Either HTTP2ClientError HTTP2Response)
+sendRequest HTTP2Client {reqQ, config} req = do
+  resp <- newEmptyTMVarIO
+  atomically $ writeTBQueue reqQ (req, resp)
+  maybe (Left HCResponseTimeout) Right <$> (connTimeout config `timeout` atomically (takeTMVar resp))
+
+runHTTP2Client :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe KeepAliveOpts -> ((Request -> (Response -> IO ()) -> IO ()) -> IO ()) -> IO ()
+runHTTP2Client tlsParams caStore host port keepAliveOpts client =
+  runTLSTransportClient tlsParams caStore host port Nothing keepAliveOpts $ \c ->
+    withTlsConfig c 16384 (`run` client)
+  where
+    run = H.run $ ClientConfig "https" (B.pack host) 20
diff --git a/src/Simplex/Messaging/Transport/HTTP2/Server.hs b/src/Simplex/Messaging/Transport/HTTP2/Server.hs
new file mode 100644
index 000000000..f546c4a0e
--- /dev/null
+++ b/src/Simplex/Messaging/Transport/HTTP2/Server.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Transport.HTTP2.Server where
+
+import Control.Concurrent.Async (Async, async, uninterruptibleCancel)
+import Control.Concurrent.STM
+import Control.Monad
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Network.HPACK (HeaderTable)
+import Network.HTTP2.Server (Aux, PushPromise, Request, Response)
+import qualified Network.HTTP2.Server as H
+import Network.Socket
+import qualified Network.TLS as T
+import Numeric.Natural (Natural)
+import Simplex.Messaging.Transport.HTTP2 (withTlsConfig)
+import Simplex.Messaging.Transport.Server (loadSupportedTLSServerParams, runTransportServer)
+
+type HTTP2ServerFunc = (Request -> (Response -> IO ()) -> IO ())
+
+data HTTP2ServerConfig = HTTP2ServerConfig
+  { qSize :: Natural,
+    http2Port :: ServiceName,
+    serverSupported :: T.Supported,
+    caCertificateFile :: FilePath,
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath
+  }
+  deriving (Show)
+
+data HTTP2Request = HTTP2Request
+  { request :: Request,
+    reqBody :: ByteString,
+    reqTrailers :: Maybe HeaderTable,
+    sendResponse :: Response -> IO ()
+  }
+
+data HTTP2Server = HTTP2Server
+  { action :: Async (),
+    reqQ :: TBQueue HTTP2Request
+  }
+
+getHTTP2Server :: HTTP2ServerConfig -> IO HTTP2Server
+getHTTP2Server HTTP2ServerConfig {qSize, http2Port, serverSupported, caCertificateFile, certificateFile, privateKeyFile} = do
+  tlsServerParams <- loadSupportedTLSServerParams serverSupported caCertificateFile certificateFile privateKeyFile
+  started <- newEmptyTMVarIO
+  reqQ <- newTBQueueIO qSize
+  action <- async $
+    runHTTP2Server started http2Port tlsServerParams $ \r sendResponse -> do
+      reqBody <- getRequestBody r ""
+      reqTrailers <- H.getRequestTrailers r
+      atomically $ writeTBQueue reqQ HTTP2Request {request = r, reqBody, reqTrailers, sendResponse}
+  void . atomically $ takeTMVar started
+  pure HTTP2Server {action, reqQ}
+  where
+    getRequestBody :: Request -> ByteString -> IO ByteString
+    getRequestBody r s =
+      H.getRequestBodyChunk r >>= \chunk ->
+        if B.null chunk then pure s else getRequestBody r $ s <> chunk
+
+closeHTTP2Server :: HTTP2Server -> IO ()
+closeHTTP2Server = uninterruptibleCancel . action
+
+runHTTP2Server :: TMVar Bool -> ServiceName -> T.ServerParams -> HTTP2ServerFunc -> IO ()
+runHTTP2Server started port serverParams http2Server =
+  runTransportServer started port serverParams $ \c -> withTlsConfig c 16384 (`H.run` server)
+  where
+    server :: Request -> Aux -> (Response -> [PushPromise] -> IO ()) -> IO ()
+    server req _aux sendResp = http2Server req (`sendResp` [])
diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs
index 74ffae279..b4cb69bbc 100644
--- a/src/Simplex/Messaging/Transport/Server.hs
+++ b/src/Simplex/Messaging/Transport/Server.hs
@@ -4,6 +4,7 @@
 
 module Simplex.Messaging.Transport.Server
   ( runTransportServer,
+    loadSupportedTLSServerParams,
     loadTLSServerParams,
     loadFingerprint,
     smpServerHandshake,
@@ -71,7 +72,10 @@ startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
     setStarted sock = atomically (tryPutTMVar started True) >> pure sock
 
 loadTLSServerParams :: FilePath -> FilePath -> FilePath -> IO T.ServerParams
-loadTLSServerParams caCertificateFile certificateFile privateKeyFile =
+loadTLSServerParams = loadSupportedTLSServerParams supportedParameters
+
+loadSupportedTLSServerParams :: T.Supported -> FilePath -> FilePath -> FilePath -> IO T.ServerParams
+loadSupportedTLSServerParams serverSupported caCertificateFile certificateFile privateKeyFile =
   fromCredential <$> loadServerCredential
   where
     loadServerCredential :: IO T.Credential
@@ -85,7 +89,7 @@ loadTLSServerParams caCertificateFile certificateFile privateKeyFile =
         { T.serverWantClientCert = False,
           T.serverShared = def {T.sharedCredentials = T.Credentials [credential]},
           T.serverHooks = def,
-          T.serverSupported = supportedParameters
+          T.serverSupported = serverSupported
         }
 
 loadFingerprint :: FilePath -> IO Fingerprint
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index a08e72623..b20154a3f 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -9,13 +9,11 @@ module AgentTests.FunctionalAPITests (functionalAPITests) where
 
 import Control.Monad.Except (ExceptT, runExceptT)
 import Control.Monad.IO.Unlift
-import NtfClient (withNtfServer)
 import SMPAgentClient
 import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), PushProvider (..))
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..))
 import System.Timeout
@@ -50,14 +48,11 @@ functionalAPITests t = do
       testAsyncServerOffline t
     it "should notify after HELLO timeout" $
       withSmpServer t testAsyncHelloTimeout
-  describe "Notification server" $ do
-    it "should register device token" $
-      withNtfServer t testNotificationToken
 
 testAgentClient :: IO ()
 testAgentClient = do
-  alice <- getSMPAgentClient cfg initAgentServers
-  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
+  alice <- getSMPAgentClient agentCfg initAgentServers
+  bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
   Right () <- runExceptT $ do
     (bobId, qInfo) <- createConnection alice SCMInvitation
     aliceId <- joinConnection bob qInfo "bob's connInfo"
@@ -100,13 +95,13 @@ testAgentClient = do
 
 testAsyncInitiatingOffline :: IO ()
 testAsyncInitiatingOffline = do
-  alice <- getSMPAgentClient cfg initAgentServers
-  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
+  alice <- getSMPAgentClient agentCfg initAgentServers
+  bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
   Right () <- runExceptT $ do
     (bobId, cReq) <- createConnection alice SCMInvitation
     disconnectAgentClient alice
     aliceId <- joinConnection bob cReq "bob's connInfo"
-    alice' <- liftIO $ getSMPAgentClient cfg initAgentServers
+    alice' <- liftIO $ getSMPAgentClient agentCfg initAgentServers
     subscribeConnection alice' bobId
     ("", _, CONF confId "bob's connInfo") <- get alice'
     allowConnection alice' bobId confId "alice's connInfo"
@@ -118,15 +113,15 @@ testAsyncInitiatingOffline = do
 
 testAsyncJoiningOfflineBeforeActivation :: IO ()
 testAsyncJoiningOfflineBeforeActivation = do
-  alice <- getSMPAgentClient cfg initAgentServers
-  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
+  alice <- getSMPAgentClient agentCfg initAgentServers
+  bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
   Right () <- runExceptT $ do
     (bobId, qInfo) <- createConnection alice SCMInvitation
     aliceId <- joinConnection bob qInfo "bob's connInfo"
     disconnectAgentClient bob
     ("", _, CONF confId "bob's connInfo") <- get alice
     allowConnection alice bobId confId "alice's connInfo"
-    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
+    bob' <- liftIO $ getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
     subscribeConnection bob' aliceId
     get alice ##> ("", bobId, CON)
     get bob' ##> ("", aliceId, INFO "alice's connInfo")
@@ -136,18 +131,18 @@ testAsyncJoiningOfflineBeforeActivation = do
 
 testAsyncBothOffline :: IO ()
 testAsyncBothOffline = do
-  alice <- getSMPAgentClient cfg initAgentServers
-  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
+  alice <- getSMPAgentClient agentCfg initAgentServers
+  bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
   Right () <- runExceptT $ do
     (bobId, cReq) <- createConnection alice SCMInvitation
     disconnectAgentClient alice
     aliceId <- joinConnection bob cReq "bob's connInfo"
     disconnectAgentClient bob
-    alice' <- liftIO $ getSMPAgentClient cfg initAgentServers
+    alice' <- liftIO $ getSMPAgentClient agentCfg initAgentServers
     subscribeConnection alice' bobId
     ("", _, CONF confId "bob's connInfo") <- get alice'
     allowConnection alice' bobId confId "alice's connInfo"
-    bob' <- liftIO $ getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
+    bob' <- liftIO $ getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
     subscribeConnection bob' aliceId
     get alice' ##> ("", bobId, CON)
     get bob' ##> ("", aliceId, INFO "alice's connInfo")
@@ -157,8 +152,8 @@ testAsyncBothOffline = do
 
 testAsyncServerOffline :: ATransport -> IO ()
 testAsyncServerOffline t = do
-  alice <- getSMPAgentClient cfg initAgentServers
-  bob <- getSMPAgentClient cfg {dbFile = testDB2} initAgentServers
+  alice <- getSMPAgentClient agentCfg initAgentServers
+  bob <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
   -- create connection and shutdown the server
   Right (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ ->
     runExceptT $ createConnection alice SCMInvitation
@@ -181,8 +176,8 @@ testAsyncServerOffline t = do
 
 testAsyncHelloTimeout :: IO ()
 testAsyncHelloTimeout = do
-  alice <- getSMPAgentClient cfg initAgentServers
-  bob <- getSMPAgentClient cfg {dbFile = testDB2, helloTimeout = 1} initAgentServers
+  alice <- getSMPAgentClient agentCfg initAgentServers
+  bob <- getSMPAgentClient agentCfg {dbFile = testDB2, helloTimeout = 1} initAgentServers
   Right () <- runExceptT $ do
     (_, cReq) <- createConnection alice SCMInvitation
     disconnectAgentClient alice
@@ -190,13 +185,6 @@ testAsyncHelloTimeout = do
     get bob ##> ("", aliceId, ERR $ CONN NOT_ACCEPTED)
   pure ()
 
-testNotificationToken :: IO ()
-testNotificationToken = do
-  alice <- getSMPAgentClient cfg initAgentServers
-  Right () <- runExceptT $ do
-    registerNtfToken alice $ DeviceToken PPApns "abcd"
-  pure ()
-
 exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetings alice bobId bob aliceId = do
   5 <- sendMessage alice bobId "hello"
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
new file mode 100644
index 000000000..9b6a9e0f6
--- /dev/null
+++ b/tests/AgentTests/NotificationTests.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module AgentTests.NotificationTests where
+
+import Control.Monad.Except
+import qualified Data.Aeson as J
+import qualified Data.Aeson.Types as JT
+import Data.Bifunctor (bimap)
+import qualified Data.ByteString.Base64.URL as U
+import Data.ByteString.Char8 (ByteString)
+import Data.Text.Encoding (encodeUtf8)
+import NtfClient
+import SMPAgentClient (agentCfg, initAgentServers)
+import Simplex.Messaging.Agent
+import Simplex.Messaging.Agent.Protocol
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Push.APNS
+import Simplex.Messaging.Transport (ATransport)
+import Test.Hspec
+import UnliftIO.STM
+
+notificationTests :: ATransport -> Spec
+notificationTests t = do
+  describe "Managing notification tokens" $
+    it "should register and verify notification token" $
+      withAPNSMockServer $ \apns -> withNtfServer t $ testNotificationToken apns
+
+testNotificationToken :: APNSMockServer -> IO ()
+testNotificationToken APNSMockServer {apnsQ} = do
+  a <- getSMPAgentClient agentCfg initAgentServers
+  Right () <- runExceptT $ do
+    let tkn = DeviceToken PPApns "abcd"
+    registerNtfToken a tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+      atomically $ readTBQueue apnsQ
+    verification <- ntfData .-> "verification"
+    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    liftIO $ sendApnsResponse APNSRespOk
+    verifyNtfToken a tkn verification nonce
+    enableNtfCron a tkn 30
+    pure ()
+  pure ()
+  where
+    (.->) :: J.Value -> J.Key -> ExceptT AgentErrorType IO ByteString
+    v .-> key = do
+      J.Object o <- pure v
+      liftEither . bimap INTERNAL (U.decodeLenient . encodeUtf8) $ JT.parseEither (J..: key) o
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index c9ef301ab..861e38016 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -1,53 +1,74 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module NtfClient where
 
+import Control.Monad
 import Control.Monad.Except (runExceptT)
 import Control.Monad.IO.Unlift
 import Crypto.Random
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
+import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Network.HTTP.Types (Status)
+import qualified Network.HTTP.Types as N
+import qualified Network.HTTP2.Server as H
 import Network.Socket
 import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
-import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
+import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
+import Simplex.Messaging.Transport.HTTP2 (http2TLSParams)
+import Simplex.Messaging.Transport.HTTP2.Client
+import Simplex.Messaging.Transport.HTTP2.Server
 import Simplex.Messaging.Transport.KeepAlive
+import UnliftIO.Async
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
-import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, takeTMVar)
+import UnliftIO.STM
 import UnliftIO.Timeout (timeout)
 
 testHost :: HostName
 testHost = "localhost"
 
-testPort :: ServiceName
-testPort = "6001"
+ntfTestPort :: ServiceName
+ntfTestPort = "6001"
+
+apnsTestPort :: ServiceName
+apnsTestPort = "6010"
 
 testKeyHash :: C.KeyHash
 testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 
 testNtfClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testNtfClient client =
-  runTransportClient testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
+  runTransportClient testHost ntfTestPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
     liftIO (runExceptT $ ntfClientHandshake h testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e
 
-cfg :: NtfServerConfig
-cfg =
+ntfServerCfg :: NtfServerConfig
+ntfServerCfg =
   NtfServerConfig
     { transports = undefined,
       subIdBytes = 24,
@@ -56,7 +77,12 @@ cfg =
       subQSize = 1,
       pushQSize = 1,
       smpAgentCfg = defaultSMPClientAgentConfig,
-      apnsConfig = defaultAPNSPushClientConfig,
+      apnsConfig =
+        defaultAPNSPushClientConfig
+          { apnsHost = "localhost",
+            apnsPort = apnsTestPort,
+            http2cfg = defaultHTTP2ClientConfig {caStoreFile = "tests/fixtures/ca.crt"}
+          },
       -- CA certificate private key is not needed for initialization
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
@@ -66,7 +92,7 @@ cfg =
 withNtfServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
 withNtfServerThreadOn t port' =
   serverBracket
-    (\started -> runNtfServerBlocking started cfg {transports = [(port', t)]})
+    (\started -> runNtfServerBlocking started ntfServerCfg {transports = [(port', t)]})
     (pure ())
 
 serverBracket :: MonadUnliftIO m => (TMVar Bool -> m ()) -> m () -> (ThreadId -> m a) -> m a
@@ -86,7 +112,7 @@ withNtfServerOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName
 withNtfServerOn t port' = withNtfServerThreadOn t port' . const
 
 withNtfServer :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
-withNtfServer t = withNtfServerOn t testPort
+withNtfServer t = withNtfServerOn t ntfTestPort
 
 runNtfTest :: forall c m a. (Transport c, MonadUnliftIO m, MonadRandom m) => (THandle c -> m a) -> m a
 runNtfTest test = withNtfServer (transport @c) $ testNtfClient test
@@ -105,4 +131,63 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
       pure ()
     tGet' h = do
       (Nothing, _, (CorrId corrId, qId, Right cmd)) <- tGet h
-      pure (Nothing, corrId, qId, cmd)
\ No newline at end of file
+      pure (Nothing, corrId, qId, cmd)
+
+data APNSMockRequest = APNSMockRequest
+  { notification :: APNSNotification,
+    sendApnsResponse :: APNSMockResponse -> IO ()
+  }
+
+data APNSMockResponse = APNSRespOk | APNSRespError Status Text
+
+data APNSMockServer = APNSMockServer
+  { action :: Async (),
+    apnsQ :: TBQueue APNSMockRequest,
+    http2Server :: HTTP2Server
+  }
+
+apnsMockServerConfig :: HTTP2ServerConfig
+apnsMockServerConfig =
+  HTTP2ServerConfig
+    { qSize = 1,
+      http2Port = apnsTestPort,
+      serverSupported = http2TLSParams,
+      caCertificateFile = "tests/fixtures/ca.crt",
+      privateKeyFile = "tests/fixtures/server.key",
+      certificateFile = "tests/fixtures/server.crt"
+    }
+
+withAPNSMockServer :: (APNSMockServer -> IO ()) -> IO ()
+withAPNSMockServer = E.bracket (getAPNSMockServer apnsMockServerConfig) closeAPNSMockServer
+
+deriving instance Generic APNSAlertBody
+
+deriving instance FromJSON APNSAlertBody
+
+instance FromJSON APNSNotificationBody where parseJSON = J.genericParseJSON apnsJSONOptions
+
+deriving instance FromJSON APNSNotification
+
+deriving instance ToJSON APNSErrorResponse
+
+getAPNSMockServer :: HTTP2ServerConfig -> IO APNSMockServer
+getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
+  http2Server <- getHTTP2Server config
+  apnsQ <- newTBQueueIO qSize
+  action <- async $ runAPNSMockServer apnsQ http2Server
+  pure APNSMockServer {action, apnsQ, http2Server}
+  where
+    runAPNSMockServer apnsQ HTTP2Server {reqQ} = forever $ do
+      HTTP2Request {reqBody, sendResponse} <- atomically $ readTBQueue reqQ
+      let sendApnsResponse = \case
+            APNSRespOk -> sendResponse $ H.responseNoBody N.ok200 []
+            APNSRespError status reason ->
+              sendResponse . H.responseBuilder status [] . lazyByteString $ J.encode APNSErrorResponse {reason}
+      case J.decodeStrict' reqBody of
+        Just notification -> atomically $ writeTBQueue apnsQ APNSMockRequest {notification, sendApnsResponse}
+        _ -> sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body"
+
+closeAPNSMockServer :: APNSMockServer -> IO ()
+closeAPNSMockServer APNSMockServer {action, http2Server} = do
+  closeHTTP2Server http2Server
+  uninterruptibleCancel action
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index 680676dea..c68c2438e 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -33,4 +33,4 @@ ntfSyntaxTests (ATransport t) = do
       (Maybe C.ASignature, ByteString, ByteString, smp) ->
       (Maybe C.ASignature, ByteString, ByteString, BrokerMsg) ->
       Expectation
-    command >#> response = ntfServerTest t command `shouldReturn` response
+    command >#> response = withAPNSMockServer $ \_ -> ntfServerTest t command `shouldReturn` response
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index be3de3e2c..d23ab522e 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -11,6 +11,7 @@ import Crypto.Random
 import qualified Data.ByteString.Char8 as B
 import qualified Data.List.NonEmpty as L
 import Network.Socket (HostName, ServiceName)
+import NtfClient (ntfTestPort)
 import SMPClient
   ( serverBracket,
     testKeyHash,
@@ -161,8 +162,8 @@ initAgentServers =
       ntf = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"]
     }
 
-cfg :: AgentConfig
-cfg =
+agentCfg :: AgentConfig
+agentCfg =
   defaultAgentConfig
     { tcpPort = agentTestPort,
       tbqSize = 1,
@@ -173,6 +174,11 @@ cfg =
             defaultTransport = (testPort, transport @TLS),
             tcpTimeout = 500_000
           },
+      ntfCfg =
+        defaultClientConfig
+          { qSize = 1,
+            defaultTransport = (ntfTestPort, transport @TLS)
+          },
       reconnectInterval = defaultReconnectInterval {initialInterval = 50_000},
       caCertificateFile = "tests/fixtures/ca.crt",
       privateKeyFile = "tests/fixtures/server.key",
@@ -181,7 +187,7 @@ cfg =
 
 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
 withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
-  let cfg' = cfg {tcpPort = port', dbFile = db'}
+  let cfg' = agentCfg {tcpPort = port', dbFile = db'}
       initServers' = initAgentServers {smp = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
    in serverBracket
         (\started -> runSMPAgentBlocking t started cfg' initServers')
diff --git a/tests/Test.hs b/tests/Test.hs
index bdd67c0dc..acbd15645 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE TypeApplications #-}
 
 import AgentTests (agentTests)
+import AgentTests.NotificationTests (notificationTests)
 import CoreTests.EncodingTests
 import CoreTests.ProtocolErrorTests
 import CoreTests.VersionRangeTests
@@ -9,11 +10,14 @@ import ServerTests
 import Simplex.Messaging.Transport (TLS, Transport (..))
 import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
+import System.Environment (setEnv)
 import Test.Hspec
 
 main :: IO ()
 main = do
   createDirectoryIfMissing False "tests/tmp"
+  setEnv "APNS_KEY_ID" "H82WD9K9AQ"
+  setEnv "APNS_KEY_FILE" "./tests/fixtures/AuthKey_H82WD9K9AQ.p8"
   hspec $ do
     describe "Core tests" $ do
       describe "Encoding tests" encodingTests
@@ -21,6 +25,8 @@ main = do
       describe "Version range" versionRangeTests
     describe "SMP server via TLS" $ serverTests (transport @TLS)
     describe "SMP server via WebSockets" $ serverTests (transport @WS)
-    describe "Ntf server via TLS" $ ntfServerTests (transport @TLS)
+    describe "Notifications server" $ do
+      ntfServerTests (transport @TLS)
+      notificationTests (transport @TLS)
     describe "SMP client agent" $ agentTests (transport @TLS)
   removeDirectoryRecursive "tests/tmp"
diff --git a/tests/fixtures/AuthKey_H82WD9K9AQ.p8 b/tests/fixtures/AuthKey_H82WD9K9AQ.p8
new file mode 100644
index 000000000..d6531ce30
--- /dev/null
+++ b/tests/fixtures/AuthKey_H82WD9K9AQ.p8
@@ -0,0 +1,6 @@
+-----BEGIN PRIVATE KEY-----
+MIGTAgEAMBMGByqGSM49AgEGCCqGSM49AwEHBHkwdwIBAQQgWuPap5jF6eioxuHM
+XWZWUK78LdcxkTnMXWg2GqyXuBugCgYIKoZIzj0DAQehRANCAAQn64CvAIbEEzvM
+KwYjlOxVD5SxlgP1ZcYvVM/+VHLFu0aCkG7ueICTi3qWyqoB5hjjuAqwtc3EK0q0
+yupyM7Yx
+-----END PRIVATE KEY-----
\ No newline at end of file

From b5c5a8ad2a18a922ccdc0a03db651b16cd5d11a0 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Wed, 20 Apr 2022 11:54:37 +0100
Subject: [PATCH 09/12] rename Subscriptions.hs/Store.hs

---
 simplexmq.cabal                                                 | 2 +-
 src/Simplex/Messaging/Notifications/Server.hs                   | 2 +-
 src/Simplex/Messaging/Notifications/Server/Env.hs               | 2 +-
 src/Simplex/Messaging/Notifications/Server/Push/APNS.hs         | 2 +-
 .../Notifications/Server/{Subscriptions.hs => Store.hs}         | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)
 rename src/Simplex/Messaging/Notifications/Server/{Subscriptions.hs => Store.hs} (98%)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 1472db2f4..9a174f6d6 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -59,7 +59,7 @@ library
       Simplex.Messaging.Notifications.Server
       Simplex.Messaging.Notifications.Server.Env
       Simplex.Messaging.Notifications.Server.Push.APNS
-      Simplex.Messaging.Notifications.Server.Subscriptions
+      Simplex.Messaging.Notifications.Server.Store
       Simplex.Messaging.Notifications.Transport
       Simplex.Messaging.Parsers
       Simplex.Messaging.Protocol
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 5d81b3715..babe98a70 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -23,7 +23,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Push.APNS
-import Simplex.Messaging.Notifications.Server.Subscriptions
+import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol (ErrorType (..), SignedTransmission, Transmission, encodeTransmission, tGet, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index ce00ab354..7443a87f2 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -21,7 +21,7 @@ import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS
-import Simplex.Messaging.Notifications.Server.Subscriptions
+import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Protocol (CorrId, Transmission)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 2f826e469..7c62f630a 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -45,7 +45,7 @@ import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Notifications.Server.Subscriptions (NtfTknData (..))
+import Simplex.Messaging.Notifications.Server.Store (NtfTknData (..))
 import Simplex.Messaging.Protocol (NotifierId, SMPServer)
 import Simplex.Messaging.Transport.HTTP2.Client
 import System.Environment (getEnv)
diff --git a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs b/src/Simplex/Messaging/Notifications/Server/Store.hs
similarity index 98%
rename from src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
rename to src/Simplex/Messaging/Notifications/Server/Store.hs
index 9123a690f..bc7040b67 100644
--- a/src/Simplex/Messaging/Notifications/Server/Subscriptions.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
-module Simplex.Messaging.Notifications.Server.Subscriptions where
+module Simplex.Messaging.Notifications.Server.Store where
 
 import Control.Concurrent.STM
 import qualified Simplex.Messaging.Crypto as C

From e6fbaf5e503429f00041863fb943b331b29f2c24 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 21 Apr 2022 17:04:26 +0100
Subject: [PATCH 10/12] primary tokens (#356)

* primary tokens

* support repeat token registration (TODO fix tests)

* fix notifications tests

* fix/test repeat/new registrations of the same token

* re-register token when subsequent ntf command fails with AUTH error (e.g. when server is re-started)

* cancel periodic notifications when token is deleted on the server

* debug failing test on CI

* fix notification test in CI

* debug CI test

* add delay in notificaitons test after server restart
---
 src/Simplex/Messaging/Agent.hs                |  42 ++++--
 src/Simplex/Messaging/Agent/Client.hs         |  43 +++---
 src/Simplex/Messaging/Agent/Protocol.hs       |   4 +
 src/Simplex/Messaging/Client/Agent.hs         |   4 +-
 .../Messaging/Notifications/Protocol.hs       |   3 +-
 src/Simplex/Messaging/Notifications/Server.hs |  43 +++---
 .../Messaging/Notifications/Server/Store.hs   |  76 ++++++++--
 src/Simplex/Messaging/Server.hs               |   5 +-
 .../Messaging/Server/QueueStore/STM.hs        |   9 +-
 src/Simplex/Messaging/TMap.hs                 |   5 +
 src/Simplex/Messaging/Util.hs                 |   3 +
 tests/AgentTests/NotificationTests.hs         | 138 ++++++++++++++++--
 12 files changed, 291 insertions(+), 84 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 39e351f99..a2aeb9d68 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -52,6 +52,7 @@ module Simplex.Messaging.Agent
     registerNtfToken,
     verifyNtfToken,
     enableNtfCron,
+    checkNtfToken,
     deleteNtfToken,
     logConnection,
   )
@@ -89,10 +90,10 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Client
 import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..))
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, MsgBody)
+import Simplex.Messaging.Protocol (BrokerMsg, ErrorType (AUTH), MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (bshow, liftError, tryError, unlessM)
+import Simplex.Messaging.Util (bshow, liftError, tryError, unlessM, ($>>=))
 import Simplex.Messaging.Version
 import System.Random (randomR)
 import UnliftIO.Async (async, race_)
@@ -172,6 +173,9 @@ verifyNtfToken c = withAgentEnv c .:. verifyNtfToken' c
 enableNtfCron :: AgentErrorMonad m => AgentClient -> DeviceToken -> Word16 -> m ()
 enableNtfCron c = withAgentEnv c .: enableNtfCron' c
 
+checkNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> m NtfTknStatus
+checkNtfToken c = withAgentEnv c . checkNtfToken' c
+
 deleteNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> m ()
 deleteNtfToken c = withAgentEnv c . deleteNtfToken' c
 
@@ -552,7 +556,7 @@ registerNtfToken' c deviceToken =
               registerToken tkn
         _ -> throwError $ CMD PROHIBITED
   where
-    t tkn = withToken tkn Nothing
+    t tkn = withToken c tkn Nothing
     registerToken :: NtfToken -> m ()
     registerToken tkn@NtfToken {ntfPubKey, ntfDhKeys = (pubDhKey, privDhKey)} = do
       (tknId, srvPubDhKey) <- agentNtfRegisterToken c tkn ntfPubKey pubDhKey
@@ -565,7 +569,7 @@ verifyNtfToken' c deviceToken code nonce =
   withStore (`getDeviceNtfToken` deviceToken) >>= \case
     (Just tkn@NtfToken {ntfTokenId = Just tknId, ntfDhSecret = Just dhSecret}, _) -> do
       code' <- liftEither . bimap cryptoError NtfRegCode $ C.cbDecrypt dhSecret nonce code
-      withToken tkn (Just (NTConfirmed, NTAVerify code')) (NTActive, Just NTACheck) $
+      withToken c tkn (Just (NTConfirmed, NTAVerify code')) (NTActive, Just NTACheck) $
         agentNtfVerifyToken c tknId tkn code'
     _ -> throwError $ CMD PROHIBITED
 
@@ -574,7 +578,7 @@ enableNtfCron' c deviceToken interval = do
   when (interval < 20) . throwError $ CMD PROHIBITED
   withStore (`getDeviceNtfToken` deviceToken) >>= \case
     (Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus = NTActive}, _) ->
-      withToken tkn (Just (NTActive, NTACron interval)) (cronSuccess interval) $
+      withToken c tkn (Just (NTActive, NTACron interval)) (cronSuccess interval) $
         agentNtfEnableCron c tknId tkn interval
     _ -> throwError $ CMD PROHIBITED
 
@@ -583,6 +587,12 @@ cronSuccess interval
   | interval == 0 = (NTActive, Just NTACheck)
   | otherwise = (NTActive, Just $ NTACron interval)
 
+checkNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> m NtfTknStatus
+checkNtfToken' c deviceToken =
+  withStore (`getDeviceNtfToken` deviceToken) >>= \case
+    (Just tkn@NtfToken {ntfTokenId = Just tknId}, _) -> agentNtfCheckToken c tknId tkn
+    _ -> throwError $ CMD PROHIBITED
+
 deleteNtfToken' :: AgentMonad m => AgentClient -> DeviceToken -> m ()
 deleteNtfToken' c deviceToken =
   withStore (`getDeviceNtfToken` deviceToken) >>= \case
@@ -593,15 +603,23 @@ deleteToken_ :: AgentMonad m => AgentClient -> NtfToken -> m ()
 deleteToken_ c tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
   forM_ ntfTokenId $ \tknId -> do
     withStore $ \st -> updateNtfToken st tkn ntfTknStatus (Just NTADelete)
-    agentNtfDeleteToken c tknId tkn
+    agentNtfDeleteToken c tknId tkn `catchError` \case
+      NTF AUTH -> pure ()
+      e -> throwError e
   withStore $ \st -> removeNtfToken st tkn
 
-withToken :: AgentMonad m => NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> m a -> m a
-withToken tkn from_ (toStatus, toAction_) f = do
+withToken :: AgentMonad m => AgentClient -> NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> m a -> m a
+withToken c tkn@NtfToken {deviceToken} from_ (toStatus, toAction_) f = do
   forM_ from_ $ \(status, action) -> withStore $ \st -> updateNtfToken st tkn status (Just action)
-  res <- f
-  withStore $ \st -> updateNtfToken st tkn toStatus toAction_
-  pure res
+  tryError f >>= \case
+    Right res -> do
+      withStore $ \st -> updateNtfToken st tkn toStatus toAction_
+      pure res
+    Left e@(NTF AUTH) -> do
+      withStore $ \st -> removeNtfToken st tkn
+      registerNtfToken' c deviceToken
+      throwError e
+    Left e -> throwError e
 
 setNtfServers' :: AgentMonad m => AgentClient -> [NtfServer] -> m ()
 setNtfServers' c servers = do
@@ -678,7 +696,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (srv, sessId, rId, cmd)
                 _ -> prohibited >> ack
             _ -> prohibited >> ack
         SMP.END ->
-          atomically (TM.lookup srv smpClients >>= fmap join . mapM tryReadTMVar >>= processEND)
+          atomically (TM.lookup srv smpClients $>>= tryReadTMVar >>= processEND)
             >>= logServer "<--" c srv rId
           where
             processEND = \case
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 8108f36fd..e063ae9bc 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -8,6 +9,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Agent.Client
   ( AgentClient (..),
@@ -66,7 +68,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Client
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
+import Simplex.Messaging.Protocol (BrokerMsg, ErrorType, ProtocolServer (..), QueueId, QueueIdsKeys (..), SndPublicVerifyKey)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -132,10 +134,15 @@ type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorTy
 
 class ProtocolServerClient msg where
   getProtocolServerClient :: AgentMonad m => AgentClient -> ProtocolServer -> m (ProtocolClient msg)
+  protocolError :: ErrorType -> AgentErrorType
 
-instance ProtocolServerClient BrokerMsg where getProtocolServerClient = getSMPServerClient
+instance ProtocolServerClient BrokerMsg where
+  getProtocolServerClient = getSMPServerClient
+  protocolError = SMP
 
-instance ProtocolServerClient NtfResponse where getProtocolServerClient = getNtfServerClient
+instance ProtocolServerClient NtfResponse where
+  getProtocolServerClient = getNtfServerClient
+  protocolError = NTF
 
 getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPServer -> m SMPClient
 getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
@@ -148,7 +155,7 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
     connectClient = do
       cfg <- asks $ smpCfg . config
       u <- askUnliftIO
-      liftEitherError protocolClientError (getProtocolClient srv cfg (Just msgQ) $ clientDisconnected u)
+      liftEitherError (protocolClientError SMP) (getProtocolClient srv cfg (Just msgQ) $ clientDisconnected u)
 
     clientDisconnected :: UnliftIO m -> IO ()
     clientDisconnected u = do
@@ -207,7 +214,7 @@ getSMPServerClient c@AgentClient {smpClients, msgQ} srv =
           e@PCEResponseTimeout -> throwError e
           e@PCENetworkError -> throwError e
           e -> do
-            liftIO $ notifySub (ERR $ protocolClientError e) connId
+            liftIO $ notifySub (ERR $ protocolClientError SMP e) connId
             atomically $ removePendingSubscription c srv connId
 
     notifySub :: ACommand 'Agent -> ConnId -> IO ()
@@ -223,7 +230,7 @@ getNtfServerClient c@AgentClient {ntfClients} srv =
     connectClient :: m NtfClient
     connectClient = do
       cfg <- asks $ ntfCfg . config
-      liftEitherError protocolClientError (getProtocolClient srv cfg Nothing clientDisconnected)
+      liftEitherError (protocolClientError NTF) (getProtocolClient srv cfg Nothing clientDisconnected)
 
     clientDisconnected :: IO ()
     clientDisconnected = do
@@ -322,18 +329,18 @@ withLogClient_ c srv qId cmdStr action = do
   logServer "<--" c srv qId "OK"
   return res
 
-withClient :: (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
-withClient c srv action = withClient_ c srv $ liftClient . action
+withClient :: forall m msg a. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
+withClient c srv action = withClient_ c srv $ liftClient (protocolError @msg) . action
 
-withLogClient :: (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> QueueId -> ByteString -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
-withLogClient c srv qId cmdStr action = withLogClient_ c srv qId cmdStr $ liftClient . action
+withLogClient :: forall m msg a. (AgentMonad m, ProtocolServerClient msg) => AgentClient -> ProtocolServer -> QueueId -> ByteString -> (ProtocolClient msg -> ExceptT ProtocolClientError IO a) -> m a
+withLogClient c srv qId cmdStr action = withLogClient_ c srv qId cmdStr $ liftClient (protocolError @msg) . action
 
-liftClient :: AgentMonad m => ExceptT ProtocolClientError IO a -> m a
-liftClient = liftError protocolClientError
+liftClient :: AgentMonad m => (ErrorType -> AgentErrorType) -> ExceptT ProtocolClientError IO a -> m a
+liftClient = liftError . protocolClientError
 
-protocolClientError :: ProtocolClientError -> AgentErrorType
-protocolClientError = \case
-  PCEProtocolError e -> SMP e
+protocolClientError :: (ErrorType -> AgentErrorType) -> ProtocolClientError -> AgentErrorType
+protocolClientError protocolError_ = \case
+  PCEProtocolError e -> protocolError_ e
   PCEResponseError e -> BROKER $ RESPONSE e
   PCEUnexpectedResponse -> BROKER UNEXPECTED
   PCEResponseTimeout -> BROKER TIMEOUT
@@ -428,14 +435,14 @@ sendConfirmation c sq@SndQueue {server, sndId, sndPublicKey = Just sndPublicKey,
   withLogClient_ c server sndId "SEND <CONF>" $ \smp -> do
     let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
     msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
-    liftClient $ sendSMPMessage smp Nothing sndId msg
+    liftClient SMP $ sendSMPMessage smp Nothing sndId msg
 sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
 
 sendInvitation :: forall m. AgentMonad m => AgentClient -> Compatible SMPQueueInfo -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> m ()
 sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) connReq connInfo =
   withLogClient_ c smpServer senderId "SEND <INV>" $ \smp -> do
     msg <- mkInvitation
-    liftClient $ sendSMPMessage smp Nothing senderId msg
+    liftClient SMP $ sendSMPMessage smp Nothing senderId msg
   where
     mkInvitation :: m ByteString
     -- this is only encrypted with per-queue E2E, not with double ratchet
@@ -469,7 +476,7 @@ sendAgentMessage c sq@SndQueue {server, sndId, sndPrivateKey} agentMsg =
   withLogClient_ c server sndId "SEND <MSG>" $ \smp -> do
     let clientMsg = SMP.ClientMessage SMP.PHEmpty agentMsg
     msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
-    liftClient $ sendSMPMessage smp (Just sndPrivateKey) sndId msg
+    liftClient SMP $ sendSMPMessage smp (Just sndPrivateKey) sndId msg
 
 agentNtfRegisterToken :: AgentMonad m => AgentClient -> NtfToken -> C.APublicVerifyKey -> C.PublicKeyX25519 -> m (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index dbe47d908..8be63a060 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -686,6 +686,8 @@ data AgentErrorType
     CONN {connErr :: ConnectionErrorType}
   | -- | SMP protocol errors forwarded to agent clients
     SMP {smpErr :: ErrorType}
+  | -- | NTF protocol errors forwarded to agent clients
+    NTF {ntfErr :: ErrorType}
   | -- | SMP server errors
     BROKER {brokerErr :: BrokerErrorType}
   | -- | errors of other agents
@@ -774,6 +776,7 @@ instance StrEncoding AgentErrorType where
     "CMD " *> (CMD <$> parseRead1)
       <|> "CONN " *> (CONN <$> parseRead1)
       <|> "SMP " *> (SMP <$> strP)
+      <|> "NTF " *> (NTF <$> strP)
       <|> "BROKER RESPONSE " *> (BROKER . RESPONSE <$> strP)
       <|> "BROKER TRANSPORT " *> (BROKER . TRANSPORT <$> transportErrorP)
       <|> "BROKER " *> (BROKER <$> parseRead1)
@@ -783,6 +786,7 @@ instance StrEncoding AgentErrorType where
     CMD e -> "CMD " <> bshow e
     CONN e -> "CONN " <> bshow e
     SMP e -> "SMP " <> strEncode e
+    NTF e -> "NTF " <> strEncode e
     BROKER (RESPONSE e) -> "BROKER RESPONSE " <> strEncode e
     BROKER (TRANSPORT e) -> "BROKER TRANSPORT " <> serializeTransportError e
     BROKER e -> "BROKER " <> bshow e
diff --git a/src/Simplex/Messaging/Client/Agent.hs b/src/Simplex/Messaging/Client/Agent.hs
index 7a62dc465..1f9d215cd 100644
--- a/src/Simplex/Messaging/Client/Agent.hs
+++ b/src/Simplex/Messaging/Client/Agent.hs
@@ -28,7 +28,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (BrokerMsg, ProtocolServer (..), QueueId, SMPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (tryE, whenM)
+import Simplex.Messaging.Util (tryE, whenM, ($>>=))
 import System.Timeout (timeout)
 import UnliftIO (async, forConcurrently_)
 import UnliftIO.Exception (Exception)
@@ -295,7 +295,7 @@ removeSub_ :: TMap SMPServer (TMap SMPSub C.APrivateSignKey) -> SMPServer -> SMP
 removeSub_ subs srv s = TM.lookup srv subs >>= mapM_ (TM.delete s)
 
 getSubKey :: TMap SMPServer (TMap SMPSub C.APrivateSignKey) -> SMPServer -> SMPSub -> STM (Maybe C.APrivateSignKey)
-getSubKey subs srv s = fmap join . mapM (TM.lookup s) =<< TM.lookup srv subs
+getSubKey subs srv s = TM.lookup srv subs $>>= TM.lookup s
 
 hasSub :: TMap SMPServer (TMap SMPSub C.APrivateSignKey) -> SMPServer -> SMPSub -> STM Bool
 hasSub subs srv s = maybe (pure False) (TM.member s) =<< TM.lookup srv subs
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index d5985d213..d3ad6d043 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -264,6 +264,7 @@ data NtfResponse
   | NRTkn NtfTknStatus
   | NRSub NtfSubStatus
   | NRPong
+  deriving (Show)
 
 instance ProtocolEncoding NtfResponse where
   type Tag NtfResponse = NtfResponseTag
@@ -361,7 +362,7 @@ data NtfSubStatus
     NSEnd
   | -- | SMP AUTH error
     NSSMPAuth
-  deriving (Eq)
+  deriving (Eq, Show)
 
 instance Encoding NtfSubStatus where
   smpEncode = \case
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index babe98a70..f7100cf14 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -117,7 +117,7 @@ ntfPush s@NtfPushServer {pushQ} = liftIO . forever . runExceptT $ do
     (_, PNVerification _) -> do
       -- TODO check token status
       deliverNotification pp tkn ntf
-      atomically $ writeTVar tknStatus NTConfirmed
+      atomically $ modifyTVar tknStatus $ \status' -> if status' == NTActive then NTActive else NTConfirmed
     (NTActive, PNCheckMessages) -> do
       deliverNotification pp tkn ntf
     _ -> do
@@ -166,26 +166,26 @@ verifyNtfTransmission ::
 verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do
   st <- asks store
   case cmd of
-    NtfCmd SToken c@(TNEW n@(NewNtfTkn _ k _)) -> do
-      r_ <- atomically $ getNtfToken st entId
+    NtfCmd SToken c@(TNEW tkn@(NewNtfTkn _ k _)) -> do
+      r_ <- atomically $ getNtfTokenRegistration st tkn
       pure $
         if verifyCmdSignature sig_ signed k
           then case r_ of
-            Just r@(NtfTkn NtfTknData {tknVerifyKey})
-              | k == tknVerifyKey -> tknCmd r c
+            Just t@NtfTknData {tknVerifyKey}
+              | k == tknVerifyKey -> verifiedTknCmd t c
               | otherwise -> VRFailed
-            _ -> VRVerified (NtfReqNew corrId (ANE SToken n))
+            _ -> VRVerified (NtfReqNew corrId (ANE SToken tkn))
           else VRFailed
     NtfCmd SToken c -> do
-      r_ <- atomically $ getNtfToken st entId
-      pure $ case r_ of
-        Just r@(NtfTkn NtfTknData {tknVerifyKey})
-          | verifyCmdSignature sig_ signed tknVerifyKey -> tknCmd r c
+      t_ <- atomically $ getNtfToken st entId
+      pure $ case t_ of
+        Just t@NtfTknData {tknVerifyKey}
+          | verifyCmdSignature sig_ signed tknVerifyKey -> verifiedTknCmd t c
           | otherwise -> VRFailed
         _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` VRFailed
     _ -> pure VRFailed
   where
-    tknCmd r c = VRVerified (NtfReqCmd SToken r (corrId, entId, c))
+    verifiedTknCmd t c = VRVerified (NtfReqCmd SToken (NtfTkn t) (corrId, entId, c))
 
 client :: forall m. (MonadUnliftIO m, MonadReader NtfEnv m) => NtfServerClient -> NtfSubscriber -> NtfPushServer -> m ()
 client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {pushQ, intervalNotifiers} =
@@ -204,11 +204,11 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {push
         tknId <- getId
         regCode <- getRegCode
         atomically $ do
-          tkn <- mkNtfTknData newTkn ks dhSecret regCode
+          tkn <- mkNtfTknData tknId newTkn ks dhSecret regCode
           addNtfToken st tknId tkn
           writeTBQueue pushQ (tkn, PNVerification regCode)
         pure (corrId, "", NRId tknId srvDhPubKey)
-      NtfReqCmd SToken (NtfTkn tkn@NtfTknData {tknStatus, tknRegCode, tknDhSecret, tknDhKeys = (srvDhPubKey, srvDhPrivKey)}) (corrId, tknId, cmd) -> do
+      NtfReqCmd SToken (NtfTkn tkn@NtfTknData {ntfTknId, tknStatus, tknRegCode, tknDhSecret, tknDhKeys = (srvDhPubKey, srvDhPrivKey)}) (corrId, tknId, cmd) -> do
         status <- readTVarIO tknStatus
         (corrId,tknId,) <$> case cmd of
           TNEW (NewNtfTkn _ _ dhPubKey) -> do
@@ -218,12 +218,15 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {push
             if tknDhSecret == dhSecret
               then do
                 atomically $ writeTBQueue pushQ (tkn, PNVerification tknRegCode)
-                pure $ NRId tknId srvDhPubKey
+                pure $ NRId ntfTknId srvDhPubKey
               else pure $ NRErr AUTH
           TVFY code -- this allows repeated verification for cases when client connection dropped before server response
             | (status == NTRegistered || status == NTConfirmed || status == NTActive) && tknRegCode == code -> do
               logDebug "TVFY - token verified"
+              st <- asks store
               atomically $ writeTVar tknStatus NTActive
+              tIds <- atomically $ removeInactiveTokenRegistrations st tkn
+              forM_ tIds cancelInvervalNotifications
               pure NROk
             | otherwise -> do
               logDebug "TVFY - incorrect code or token status"
@@ -233,12 +236,12 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {push
             logDebug "TDEL"
             st <- asks store
             atomically $ deleteNtfToken st tknId
+            cancelInvervalNotifications tknId
             pure NROk
-          TCRN 0 ->
+          TCRN 0 -> do
             logDebug "TCRN 0"
-              >> atomically (TM.lookupDelete tknId intervalNotifiers)
-              >>= mapM_ (uninterruptibleCancel . action)
-              >> pure NROk
+            cancelInvervalNotifications tknId
+            pure NROk
           TCRN int
             | int < 20 -> pure $ NRErr QUOTA
             | otherwise -> do
@@ -274,6 +277,10 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {subQ = _} NtfPushServer {push
     getRandomBytes n = do
       gVar <- asks idsDrg
       atomically (C.pseudoRandomBytes n gVar)
+    cancelInvervalNotifications :: NtfTokenId -> m ()
+    cancelInvervalNotifications tknId =
+      atomically (TM.lookupDelete tknId intervalNotifiers)
+        >>= mapM_ (uninterruptibleCancel . action)
 
 -- NReqCreate corrId tokenId smpQueue -> pure (corrId, "", NROk)
 -- do
diff --git a/src/Simplex/Messaging/Notifications/Server/Store.hs b/src/Simplex/Messaging/Notifications/Server/Store.hs
index bc7040b67..e39e7d3e1 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store.hs
@@ -2,30 +2,38 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Notifications.Server.Store where
 
 import Control.Concurrent.STM
+import Control.Monad
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.Map.Strict as M
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util ((<$$>))
+import Simplex.Messaging.Util (whenM, ($>>=))
 
 data NtfStore = NtfStore
   { tokens :: TMap NtfTokenId NtfTknData,
-    tokenIds :: TMap DeviceToken NtfTokenId
+    tokenRegistrations :: TMap DeviceToken (TMap ByteString NtfTokenId)
   }
 
 newNtfStore :: STM NtfStore
 newNtfStore = do
   tokens <- TM.empty
-  tokenIds <- TM.empty
-  pure NtfStore {tokens, tokenIds}
+  tokenRegistrations <- TM.empty
+  pure NtfStore {tokens, tokenRegistrations}
 
 data NtfTknData = NtfTknData
-  { token :: DeviceToken,
+  { ntfTknId :: NtfTokenId,
+    token :: DeviceToken,
     tknStatus :: TVar NtfTknStatus,
     tknVerifyKey :: C.APublicVerifyKey,
     tknDhKeys :: C.KeyPair 'C.X25519,
@@ -33,10 +41,10 @@ data NtfTknData = NtfTknData
     tknRegCode :: NtfRegCode
   }
 
-mkNtfTknData :: NewNtfEntity 'Token -> C.KeyPair 'C.X25519 -> C.DhSecretX25519 -> NtfRegCode -> STM NtfTknData
-mkNtfTknData (NewNtfTkn token tknVerifyKey _) tknDhKeys tknDhSecret tknRegCode = do
+mkNtfTknData :: NtfTokenId -> NewNtfEntity 'Token -> C.KeyPair 'C.X25519 -> C.DhSecretX25519 -> NtfRegCode -> STM NtfTknData
+mkNtfTknData ntfTknId (NewNtfTkn token tknVerifyKey _) tknDhKeys tknDhSecret tknRegCode = do
   tknStatus <- newTVar NTRegistered
-  pure NtfTknData {token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode}
+  pure NtfTknData {ntfTknId, token, tknStatus, tknVerifyKey, tknDhKeys, tknDhSecret, tknRegCode}
 
 -- data NtfSubscriptionsStore = NtfSubscriptionsStore
 
@@ -58,19 +66,57 @@ data NtfEntityRec (e :: NtfEntity) where
   NtfTkn :: NtfTknData -> NtfEntityRec 'Token
   NtfSub :: NtfSubData -> NtfEntityRec 'Subscription
 
-data ANtfEntityRec = forall e. NtfEntityI e => NER (SNtfEntity e) (NtfEntityRec e)
-
-getNtfToken :: NtfStore -> NtfTokenId -> STM (Maybe (NtfEntityRec 'Token))
-getNtfToken st tknId = NtfTkn <$$> TM.lookup tknId (tokens st)
+getNtfToken :: NtfStore -> NtfTokenId -> STM (Maybe NtfTknData)
+getNtfToken st tknId = TM.lookup tknId (tokens st)
 
 addNtfToken :: NtfStore -> NtfTokenId -> NtfTknData -> STM ()
-addNtfToken st tknId tkn@NtfTknData {token} = do
+addNtfToken st tknId tkn@NtfTknData {token, tknVerifyKey} = do
   TM.insert tknId tkn $ tokens st
-  TM.insert token tknId $ tokenIds st
+  TM.lookup token regs >>= \case
+    Just tIds -> TM.insert regKey tknId tIds
+    _ -> do
+      tIds <- TM.singleton regKey tknId
+      TM.insert token tIds regs
+  where
+    regs = tokenRegistrations st
+    regKey = C.toPubKey C.pubKeyBytes tknVerifyKey
+
+getNtfTokenRegistration :: NtfStore -> NewNtfEntity 'Token -> STM (Maybe NtfTknData)
+getNtfTokenRegistration st (NewNtfTkn token tknVerifyKey _) =
+  TM.lookup token (tokenRegistrations st)
+    $>>= TM.lookup regKey
+    $>>= (`TM.lookup` tokens st)
+  where
+    regKey = C.toPubKey C.pubKeyBytes tknVerifyKey
+
+removeInactiveTokenRegistrations :: NtfStore -> NtfTknData -> STM [NtfTokenId]
+removeInactiveTokenRegistrations st NtfTknData {ntfTknId = tId, token} =
+  TM.lookup token (tokenRegistrations st)
+    >>= maybe (pure []) removeRegs
+  where
+    removeRegs :: TMap ByteString NtfTokenId -> STM [NtfTokenId]
+    removeRegs tknRegs = do
+      tIds <- filter ((/= tId) . snd) . M.assocs <$> readTVar tknRegs
+      forM_ tIds $ \(regKey, tId') -> do
+        TM.delete regKey tknRegs
+        TM.delete tId' $ tokens st
+      pure $ map snd tIds
 
 deleteNtfToken :: NtfStore -> NtfTokenId -> STM ()
 deleteNtfToken st tknId = do
-  TM.lookupDelete tknId (tokens st) >>= mapM_ (\NtfTknData {token} -> TM.delete token $ tokenIds st)
+  TM.lookupDelete tknId (tokens st)
+    >>= mapM_
+      ( \NtfTknData {token, tknVerifyKey} ->
+          TM.lookup token regs
+            >>= mapM_
+              ( \tIds -> do
+                  TM.delete (regKey tknVerifyKey) tIds
+                  whenM (TM.null tIds) $ TM.delete token regs
+              )
+      )
+  where
+    regs = tokenRegistrations st
+    regKey = C.toPubKey C.pubKeyBytes
 
 -- getNtfRec :: NtfStore -> SNtfEntity e -> NtfEntityId -> STM (Maybe (NtfEntityRec e))
 -- getNtfRec st ent entId = case ent of
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 6809899f8..c2ce106ed 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -98,7 +98,7 @@ smpServer started = do
       m ()
     serverThread s subQ subs clientSubs unsub = forever $ do
       atomically updateSubscribers
-        >>= fmap join . mapM endPreviousSubscriptions
+        $>>= endPreviousSubscriptions
         >>= mapM_ unsub
       where
         updateSubscribers :: STM (Maybe (QueueId, Client))
@@ -110,8 +110,7 @@ smpServer started = do
                   else do
                     yes <- readTVar $ connected c'
                     pure $ if yes then Just (qId, c') else Nothing
-          TM.lookupInsert qId clnt (subs s)
-            >>= fmap join . mapM clientToBeNotified
+          TM.lookupInsert qId clnt (subs s) $>>= clientToBeNotified
         endPreviousSubscriptions :: (QueueId, Client) -> m (Maybe s)
         endPreviousSubscriptions (qId, c) = do
           void . forkIO . atomically $
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 401e7ee30..d04c8f14b 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -18,7 +18,7 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (ifM)
+import Simplex.Messaging.Util (ifM, ($>>=))
 import UnliftIO.STM
 
 data QueueStore = QueueStore
@@ -51,9 +51,8 @@ instance MonadQueueStore QueueStore STM where
     where
       getVar = case party of
         SRecipient -> TM.lookup qId queues
-        SSender -> TM.lookup qId senders >>= get
-        SNotifier -> TM.lookup qId notifiers >>= get
-      get = fmap join . mapM (`TM.lookup` queues)
+        SSender -> TM.lookup qId senders $>>= (`TM.lookup` queues)
+        SNotifier -> TM.lookup qId notifiers $>>= (`TM.lookup` queues)
 
   secureQueue :: QueueStore -> RecipientId -> SndPublicVerifyKey -> STM (Either ErrorType QueueRec)
   secureQueue QueueStore {queues} rId sKey =
@@ -91,4 +90,4 @@ toResult :: Maybe a -> Either ErrorType a
 toResult = maybe (Left AUTH) Right
 
 withQueue :: RecipientId -> TMap RecipientId (TVar QueueRec) -> (TVar QueueRec -> STM (Maybe a)) -> STM (Either ErrorType a)
-withQueue rId queues f = toResult <$> (TM.lookup rId queues >>= fmap join . mapM f)
+withQueue rId queues f = toResult <$> TM.lookup rId queues $>>= f
diff --git a/src/Simplex/Messaging/TMap.hs b/src/Simplex/Messaging/TMap.hs
index b5bc01253..761a41c93 100644
--- a/src/Simplex/Messaging/TMap.hs
+++ b/src/Simplex/Messaging/TMap.hs
@@ -2,6 +2,7 @@ module Simplex.Messaging.TMap
   ( TMap,
     empty,
     singleton,
+    Simplex.Messaging.TMap.null,
     Simplex.Messaging.TMap.lookup,
     member,
     insert,
@@ -30,6 +31,10 @@ singleton :: k -> a -> STM (TMap k a)
 singleton k v = newTVar $ M.singleton k v
 {-# INLINE singleton #-}
 
+null :: TMap k a -> STM Bool
+null m = M.null <$> readTVar m
+{-# INLINE null #-}
+
 lookup :: Ord k => k -> TMap k a -> STM (Maybe a)
 lookup k m = M.lookup k <$> readTVar m
 {-# INLINE lookup #-}
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index ea53bc60e..0d741bb43 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -65,3 +65,6 @@ whenM b a = ifM b a $ pure ()
 unlessM :: Monad m => m Bool -> m () -> m ()
 unlessM b = ifM b $ pure ()
 {-# INLINE unlessM #-}
+
+($>>=) :: (Monad m, Monad f, Traversable f) => m (f a) -> (a -> m (f b)) -> m (f b)
+f $>>= g = f >>= fmap join . mapM g
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 9b6a9e0f6..752c97760 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -3,6 +3,9 @@
 
 module AgentTests.NotificationTests where
 
+-- import Control.Logger.Simple (LogConfig (..), LogLevel (..), setLogLevel, withGlobalLogging)
+
+import Control.Concurrent (threadDelay)
 import Control.Monad.Except
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
@@ -11,21 +14,36 @@ import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import Data.Text.Encoding (encodeUtf8)
 import NtfClient
-import SMPAgentClient (agentCfg, initAgentServers)
+import SMPAgentClient (agentCfg, initAgentServers, testDB, testDB2)
 import Simplex.Messaging.Agent
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS
+import Simplex.Messaging.Protocol (ErrorType (AUTH))
 import Simplex.Messaging.Transport (ATransport)
+import Simplex.Messaging.Util (tryE)
+import System.Directory (removeFile)
 import Test.Hspec
 import UnliftIO.STM
 
 notificationTests :: ATransport -> Spec
-notificationTests t = do
-  describe "Managing notification tokens" $
-    it "should register and verify notification token" $
-      withAPNSMockServer $ \apns -> withNtfServer t $ testNotificationToken apns
+notificationTests t =
+  after_ (removeFile testDB) $
+    describe "Managing notification tokens" $ do
+      it "should register and verify notification token" $
+        withAPNSMockServer $ \apns ->
+          withNtfServer t $ testNotificationToken apns
+      it "should allow repeated registration with the same credentials" $ \_ ->
+        withAPNSMockServer $ \apns ->
+          withNtfServer t $ testNtfTokenRepeatRegistration apns
+      it "should allow the second registration with different credentials and delete the first after verification" $ \_ ->
+        withAPNSMockServer $ \apns ->
+          withNtfServer t $ testNtfTokenSecondRegistration apns
+      it "should re-register token when notification server is restarted" $ \_ ->
+        withAPNSMockServer $ \apns ->
+          testNtfTokenServerRestart t apns
 
 testNotificationToken :: APNSMockServer -> IO ()
 testNotificationToken APNSMockServer {apnsQ} = do
@@ -40,10 +58,110 @@ testNotificationToken APNSMockServer {apnsQ} = do
     liftIO $ sendApnsResponse APNSRespOk
     verifyNtfToken a tkn verification nonce
     enableNtfCron a tkn 30
+    NTActive <- checkNtfToken a tkn
+    deleteNtfToken a tkn
+    -- agent deleted this token
+    Left (CMD PROHIBITED) <- tryE $ checkNtfToken a tkn
     pure ()
   pure ()
-  where
-    (.->) :: J.Value -> J.Key -> ExceptT AgentErrorType IO ByteString
-    v .-> key = do
-      J.Object o <- pure v
-      liftEither . bimap INTERNAL (U.decodeLenient . encodeUtf8) $ JT.parseEither (J..: key) o
+
+(.->) :: J.Value -> J.Key -> ExceptT AgentErrorType IO ByteString
+v .-> key = do
+  J.Object o <- pure v
+  liftEither . bimap INTERNAL (U.decodeLenient . encodeUtf8) $ JT.parseEither (J..: key) o
+
+-- logCfg :: LogConfig
+-- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
+
+testNtfTokenRepeatRegistration :: APNSMockServer -> IO ()
+testNtfTokenRepeatRegistration APNSMockServer {apnsQ} = do
+  -- setLogLevel LogError -- LogDebug
+  -- withGlobalLogging logCfg $ do
+  a <- getSMPAgentClient agentCfg initAgentServers
+  Right () <- runExceptT $ do
+    let tkn = DeviceToken PPApns "abcd"
+    registerNtfToken a tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+      atomically $ readTBQueue apnsQ
+    verification <- ntfData .-> "verification"
+    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    liftIO $ sendApnsResponse APNSRespOk
+    registerNtfToken a tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
+      atomically $ readTBQueue apnsQ
+    _ <- ntfData' .-> "verification"
+    _ <- C.cbNonce <$> ntfData' .-> "nonce"
+    liftIO $ sendApnsResponse' APNSRespOk
+    -- can still use the first verification code, it is the same after decryption
+    verifyNtfToken a tkn verification nonce
+    enableNtfCron a tkn 30
+    NTActive <- checkNtfToken a tkn
+    pure ()
+  pure ()
+
+testNtfTokenSecondRegistration :: APNSMockServer -> IO ()
+testNtfTokenSecondRegistration APNSMockServer {apnsQ} = do
+  -- setLogLevel LogError -- LogDebug
+  -- withGlobalLogging logCfg $ do
+  a <- getSMPAgentClient agentCfg initAgentServers
+  a' <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers
+  Right () <- runExceptT $ do
+    let tkn = DeviceToken PPApns "abcd"
+    registerNtfToken a tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+      atomically $ readTBQueue apnsQ
+    verification <- ntfData .-> "verification"
+    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    liftIO $ sendApnsResponse APNSRespOk
+    verifyNtfToken a tkn verification nonce
+
+    registerNtfToken a' tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
+      atomically $ readTBQueue apnsQ
+    verification' <- ntfData' .-> "verification"
+    nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
+    liftIO $ sendApnsResponse' APNSRespOk
+
+    -- at this point the first token is still active
+    NTActive <- checkNtfToken a tkn
+    -- and the second is not yet verified
+    NTConfirmed <- checkNtfToken a' tkn
+    -- now the second token registration is verified
+    verifyNtfToken a' tkn verification' nonce'
+    -- the first registration is removed
+    Left (NTF AUTH) <- tryE $ checkNtfToken a tkn
+    -- and the second is active
+    NTActive <- checkNtfToken a' tkn
+    enableNtfCron a' tkn 30
+    pure ()
+  pure ()
+
+testNtfTokenServerRestart :: ATransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestart t APNSMockServer {apnsQ} = do
+  a <- getSMPAgentClient agentCfg initAgentServers
+  let tkn = DeviceToken PPApns "abcd"
+  Right ntfData <- withNtfServer t . runExceptT $ do
+    registerNtfToken a tkn
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <-
+      atomically $ readTBQueue apnsQ
+    liftIO $ sendApnsResponse APNSRespOk
+    pure ntfData
+  -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
+  threadDelay 1000000
+  disconnectAgentClient a
+  a' <- getSMPAgentClient agentCfg initAgentServers
+  -- server stopped before token is verified, so now the attempt to verify it will return AUTH error but re-register token,
+  -- so that repeat verification happens without restarting the clients, when notification arrives
+  Right () <- withNtfServer t . runExceptT $ do
+    verification <- ntfData .-> "verification"
+    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    Left (NTF AUTH) <- tryE $ verifyNtfToken a' tkn verification nonce
+    APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <-
+      atomically $ readTBQueue apnsQ
+    verification' <- ntfData' .-> "verification"
+    nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
+    liftIO $ sendApnsResponse' APNSRespOk
+    verifyNtfToken a' tkn verification' nonce'
+    NTActive <- checkNtfToken a' tkn
+    enableNtfCron a' tkn 30
+  pure ()

From f718a84335ae2a84bd314da2e2cc3e91e6c3b683 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 21 Apr 2022 17:07:39 +0100
Subject: [PATCH 11/12] change log level to error

---
 apps/ntf-server/Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/apps/ntf-server/Main.hs b/apps/ntf-server/Main.hs
index 41625d6f2..7a05d0a21 100644
--- a/apps/ntf-server/Main.hs
+++ b/apps/ntf-server/Main.hs
@@ -21,7 +21,7 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 main :: IO ()
 main = do
-  setLogLevel LogDebug -- TODO change to LogError in production
+  setLogLevel LogError
   withGlobalLogging logCfg $ protocolServerCLI ntfServerCLIConfig runNtfServer
 
 ntfServerCLIConfig :: ServerCLIConfig NtfServerConfig

From a2204c9b8440ac3a477ce33b4649fe6e321a4915 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 21 Apr 2022 17:15:41 +0100
Subject: [PATCH 12/12] remove comments, add EOL

---
 src/Simplex/Messaging/Agent/Store.hs                           | 3 +--
 .../SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs     | 2 +-
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index 6931f53be..ec564ceb8 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -80,8 +80,7 @@ class Monad m => MonadAgentStore s m where
   -- Notification device token persistence
   createNtfToken :: s -> NtfToken -> m ()
 
-  -- TODO this should also return old tokens so that they are deleted from the server
-  getDeviceNtfToken :: s -> DeviceToken -> m (Maybe NtfToken, [NtfToken]) -- return current token if it exists
+  getDeviceNtfToken :: s -> DeviceToken -> m (Maybe NtfToken, [NtfToken])
   updateNtfTokenRegistration :: s -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> m ()
   updateNtfToken :: s -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> m ()
   removeNtfToken :: s -> NtfToken -> m ()
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs
index 5f58ca0fd..7ddedddd3 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220404_ntf_subscriptions_draft.hs
@@ -35,4 +35,4 @@ CREATE TABLE ntf_subscriptions (
   FOREIGN KEY (smp_host, smp_port, smp_ntf_id) REFERENCES rcv_queues (host, port, ntf_id)
     ON DELETE RESTRICT ON UPDATE CASCADE
 ) WITHOUT ROWID;
-|]
\ No newline at end of file
+|]