From e90c15bb90eca295ad312ce286c8e495c6db275d Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Thu, 26 Jun 2025 16:59:25 +0200
Subject: [PATCH 01/26] Move generic push functions to Push.hs

---
 .../Messaging/Notifications/Server/Push.hs    | 81 +++++++++++++++++++
 .../Notifications/Server/Push/APNS.hs         | 59 +-------------
 2 files changed, 82 insertions(+), 58 deletions(-)
 create mode 100644 src/Simplex/Messaging/Notifications/Server/Push.hs

diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
new file mode 100644
index 0000000000..0320b8c511
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use newtype instead of data" #-}
+
+module Simplex.Messaging.Notifications.Server.Push where
+
+import Crypto.Hash.Algorithms (SHA256 (..))
+import qualified Crypto.PubKey.ECC.ECDSA as EC
+import qualified Crypto.PubKey.ECC.Types as ECT
+import qualified Crypto.Store.PKCS8 as PK
+import Data.ASN1.BinaryEncoding (DER (..))
+import Data.ASN1.Encoding
+import Data.ASN1.Types
+import Data.Aeson (ToJSON)
+import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
+import qualified Data.ByteString.Base64.URL as U
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Int (Int64)
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Text (Text)
+import Data.Time.Clock.System
+import qualified Data.X509 as X
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Parsers (defaultJSON)
+
+data JWTHeader = JWTHeader
+  { alg :: Text, -- key algorithm, ES256 for APNS
+    kid :: Text -- key ID
+  }
+  deriving (Show)
+
+data JWTClaims = JWTClaims
+  { iss :: Text, -- issuer, team ID for APNS
+    iat :: Int64 -- issue time, seconds from epoch
+  }
+  deriving (Show)
+
+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
+
+$(JQ.deriveToJSON defaultJSON ''JWTHeader)
+
+$(JQ.deriveToJSON defaultJSON ''JWTClaims)
+
+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
+  -- this pattern match is specific to APNS key type, it may need to be extended for other push providers
+  [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 (NonEmpty PNMessageData)
+  | -- | PNAlert Text
+    PNCheckMessages
+  deriving (Show)
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 39aeb93290..da647253ec 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -16,14 +16,8 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Trans.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)
-import qualified Crypto.Store.PKCS8 as PK
-import Data.ASN1.BinaryEncoding (DER (..))
-import Data.ASN1.Encoding
-import Data.ASN1.Types
 import Data.Aeson (ToJSON, (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
@@ -32,18 +26,15 @@ 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.List (find)
-import Data.List.NonEmpty (NonEmpty (..))
 import Data.Map.Strict (Map)
 import Data.Maybe (isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock.System
-import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import Network.HPACK.Token as HT
 import Network.HTTP.Types (Status)
@@ -53,6 +44,7 @@ import qualified Network.HTTP2.Client as H
 import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Push
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Server.Store.Types (NtfTknRec (..))
 import Simplex.Messaging.Parsers (defaultJSON)
@@ -62,55 +54,6 @@ import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 import System.Environment (getEnv)
 import UnliftIO.STM
 
-data JWTHeader = JWTHeader
-  { alg :: Text, -- key algorithm, ES256 for APNS
-    kid :: Text -- key ID
-  }
-  deriving (Show)
-
-data JWTClaims = JWTClaims
-  { iss :: Text, -- issuer, team ID for APNS
-    iat :: Int64 -- issue time, seconds from epoch
-  }
-  deriving (Show)
-
-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
-
-$(JQ.deriveToJSON defaultJSON ''JWTHeader)
-
-$(JQ.deriveToJSON defaultJSON ''JWTClaims)
-
-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
-  -- this pattern match is specific to APNS key type, it may need to be extended for other push providers
-  [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 (NonEmpty PNMessageData)
-  | -- | PNAlert Text
-    PNCheckMessages
-  deriving (Show)
-
 data APNSNotification = APNSNotification {aps :: APNSNotificationBody, notificationData :: Maybe J.Value}
   deriving (Show)
 

From c08c3794bab8f816f7692240ee0c90033c35a759 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 11 Jul 2025 16:48:38 +0200
Subject: [PATCH 02/26] Fix move push

---
 simplexmq.cabal                                |  1 +
 src/Simplex/Messaging/Notifications/Server.hs  |  3 ++-
 .../Messaging/Notifications/Server/Env.hs      |  1 +
 .../Messaging/Notifications/Server/Push.hs     | 18 ++++++++++++++++++
 .../Notifications/Server/Push/APNS.hs          | 12 ------------
 5 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index e96f3f1db7..dc56e4ff3d 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -259,6 +259,7 @@ library
               Simplex.Messaging.Notifications.Server.Main
               Simplex.Messaging.Notifications.Server.Prometheus
               Simplex.Messaging.Notifications.Server.Push.APNS
+              Simplex.Messaging.Notifications.Server.Push
               Simplex.Messaging.Notifications.Server.Push.APNS.Internal
               Simplex.Messaging.Notifications.Server.Stats
               Simplex.Messaging.Notifications.Server.Store
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index ac274dc08f..76dca88f9e 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -56,7 +56,7 @@ import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Control
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Prometheus
-import Simplex.Messaging.Notifications.Server.Push.APNS (PushNotification (..), PushProviderError (..))
+import Simplex.Messaging.Notifications.Server.Push (PushNotification(..), PushProviderError(..))
 import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store (NtfSTMStore, TokenNtfMessageRecord (..), stmStoreTokenLastNtf)
 import Simplex.Messaging.Notifications.Server.Store.Postgres
@@ -675,6 +675,7 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
             void $ updateTknStatus st tkn $ NTInvalid $ Just r
             err e
           PPPermanentError -> err e
+          PPInvalidPusher -> err e
       where
         retryDeliver :: IO (Either PushProviderError ())
         retryDeliver = do
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index b0eafbc630..7ed258b9a0 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -45,6 +45,7 @@ import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, Transport
 import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
+import Simplex.Messaging.Notifications.Server.Push (PushNotification, PushProviderClient)
 
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ASrvTransport, AddHTTP)],
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index 0320b8c511..3c7e57c6ab 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -30,6 +30,12 @@ import Data.Time.Clock.System
 import qualified Data.X509 as X
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Parsers (defaultJSON)
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError)
+import qualified Simplex.Messaging.Crypto as C
+import Network.HTTP.Types (Status)
+import Control.Exception (Exception)
+import Simplex.Messaging.Notifications.Server.Store.Types (NtfTknRec)
+import Control.Monad.Except (ExceptT)
 
 data JWTHeader = JWTHeader
   { alg :: Text, -- key algorithm, ES256 for APNS
@@ -79,3 +85,15 @@ data PushNotification
   | -- | PNAlert Text
     PNCheckMessages
   deriving (Show)
+
+data PushProviderError
+  = PPConnection HTTP2ClientError
+  | PPCryptoError C.CryptoError
+  | PPResponseError (Maybe Status) Text
+  | PPTokenInvalid NTInvalidReason
+  | PPRetryLater
+  | PPPermanentError
+  | PPInvalidPusher
+  deriving (Show, Exception)
+
+type PushProviderClient = NtfTknRec -> PushNotification -> ExceptT PushProviderError IO ()
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index da647253ec..2337fa7fda 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -10,7 +10,6 @@
 
 module Simplex.Messaging.Notifications.Server.Push.APNS where
 
-import Control.Exception (Exception)
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
@@ -251,17 +250,6 @@ apnsRequest c tkn ntf@APNSNotification {aps} = do
       APNSBackground {} -> "background"
       _ -> "alert"
 
-data PushProviderError
-  = PPConnection HTTP2ClientError
-  | PPCryptoError C.CryptoError
-  | PPResponseError (Maybe Status) Text
-  | PPTokenInvalid NTInvalidReason
-  | PPRetryLater
-  | PPPermanentError
-  deriving (Show, Exception)
-
-type PushProviderClient = NtfTknRec -> PushNotification -> ExceptT PushProviderError IO ()
-
 -- this is not a newtype on purpose to have a correct JSON encoding as a record
 data APNSErrorResponse = APNSErrorResponse {reason :: Text}
 

From e7e7c9bfa1e13c4bd9e491d81c71da2efef840aa Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Wed, 27 Aug 2025 11:13:25 +0200
Subject: [PATCH 03/26] Rename APNSDeviceToken

---
 src/Simplex/Messaging/Agent/Client.hs         |  2 +-
 .../Messaging/Agent/Store/AgentStore.hs       | 16 ++++++------
 .../Messaging/Notifications/Protocol.hs       | 19 +++++++-------
 src/Simplex/Messaging/Notifications/Server.hs |  4 +--
 .../Notifications/Server/Push/APNS.hs         |  2 +-
 .../Notifications/Server/Store/Postgres.hs    | 10 +++----
 tests/AgentTests/NotificationTests.hs         | 26 +++++++++----------
 tests/NtfClient.hs                            |  2 +-
 tests/NtfServerTests.hs                       |  6 ++---
 9 files changed, 44 insertions(+), 43 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 39b3534c0f..da2bea5e52 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1316,7 +1316,7 @@ runNTFServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
         (nKey, npKey) <- atomically $ C.generateAuthKeyPair a g
         (dhKey, _) <- atomically $ C.generateKeyPair g
         r <- runExceptT $ do
-          let deviceToken = DeviceToken PPApnsNull "test_ntf_token"
+          let deviceToken = APNSDeviceToken PPApnsNull "test_ntf_token"
           (tknId, _) <- liftError (testErr TSCreateNtfToken) $ ntfRegisterToken ntf nm npKey (NewNtfTkn deviceToken nKey dhKey)
           liftError (testErr TSDeleteNtfToken) $ ntfDeleteToken ntf nm npKey tknId
         ok <- netTimeoutInt (tcpTimeout $ networkConfig cfg) nm `timeout` closeProtocolClient ntf
diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
index e10f48c8fd..e19c34f32a 100644
--- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs
+++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
@@ -1382,7 +1382,7 @@ deleteCommand db cmdId =
   DB.execute db "DELETE FROM commands WHERE command_id = ?" (Only cmdId)
 
 createNtfToken :: DB.Connection -> NtfToken -> IO ()
-createNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} = do
+createNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} = do
   upsertNtfServer_ db srv
   DB.execute
     db
@@ -1409,10 +1409,10 @@ getSavedNtfToken db = do
       let ntfServer = NtfServer host port keyHash
           ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
           ntfMode = fromMaybe NMPeriodic ntfMode_
-       in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
+       in NtfToken {deviceToken = APNSDeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
 
 updateNtfTokenRegistration :: DB.Connection -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> IO ()
-updateNtfTokenRegistration db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret = do
+updateNtfTokenRegistration db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret = do
   updatedAt <- getCurrentTime
   DB.execute
     db
@@ -1424,7 +1424,7 @@ updateNtfTokenRegistration db NtfToken {deviceToken = DeviceToken provider token
     (tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
 
 updateDeviceToken :: DB.Connection -> NtfToken -> DeviceToken -> IO ()
-updateDeviceToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} (DeviceToken toProvider toToken) = do
+updateDeviceToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} (APNSDeviceToken toProvider toToken) = do
   updatedAt <- getCurrentTime
   DB.execute
     db
@@ -1436,7 +1436,7 @@ updateDeviceToken db NtfToken {deviceToken = DeviceToken provider token, ntfServ
     (toProvider, toToken, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
 
 updateNtfMode :: DB.Connection -> NtfToken -> NotificationsMode -> IO ()
-updateNtfMode db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} ntfMode = do
+updateNtfMode db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} ntfMode = do
   updatedAt <- getCurrentTime
   DB.execute
     db
@@ -1448,7 +1448,7 @@ updateNtfMode db NtfToken {deviceToken = DeviceToken provider token, ntfServer =
     (ntfMode, updatedAt, provider, token, host, port)
 
 updateNtfToken :: DB.Connection -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> IO ()
-updateNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknStatus tknAction = do
+updateNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknStatus tknAction = do
   updatedAt <- getCurrentTime
   DB.execute
     db
@@ -1460,7 +1460,7 @@ updateNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer
     (tknStatus, tknAction, updatedAt, provider, token, host, port)
 
 removeNtfToken :: DB.Connection -> NtfToken -> IO ()
-removeNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} =
+removeNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} =
   DB.execute
     db
     [sql|
@@ -1785,7 +1785,7 @@ getActiveNtfToken db =
       let ntfServer = NtfServer host port keyHash
           ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
           ntfMode = fromMaybe NMPeriodic ntfMode_
-       in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
+       in NtfToken {deviceToken = APNSDeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
 
 getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, Int64, RcvNtfDhSecret, Maybe UTCTime))
 getNtfRcvQueue db SMPQueueNtf {smpServer = (SMPServer host port _), notifierId} =
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 0b5889bb7f..1c7bf5cff6 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -411,32 +411,33 @@ instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe
 
 instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode
 
-data DeviceToken = DeviceToken PushProvider ByteString
+data DeviceToken
+  = APNSDeviceToken PushProvider ByteString
   deriving (Eq, Ord, Show)
 
 instance Encoding DeviceToken where
-  smpEncode (DeviceToken p t) = smpEncode (p, t)
-  smpP = DeviceToken <$> smpP <*> smpP
+  smpEncode (APNSDeviceToken p t) = smpEncode (p, t)
+  smpP = APNSDeviceToken <$> smpP <*> smpP
 
 instance StrEncoding DeviceToken where
-  strEncode (DeviceToken p t) = strEncode p <> " " <> t
+  strEncode (APNSDeviceToken p t) = strEncode p <> " " <> t
   strP = nullToken <|> hexToken
     where
-      nullToken = "apns_null test_ntf_token" $> DeviceToken PPApnsNull "test_ntf_token"
-      hexToken = DeviceToken <$> strP <* A.space <*> hexStringP
+      nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token"
+      hexToken = APNSDeviceToken <$> strP <* A.space <*> hexStringP
       hexStringP =
         A.takeWhile (`B.elem` "0123456789abcdef") >>= \s ->
           if even (B.length s) then pure s else fail "odd number of hex characters"
 
 instance ToJSON DeviceToken where
-  toEncoding (DeviceToken pp t) = J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t
-  toJSON (DeviceToken pp t) = J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t]
+  toEncoding (APNSDeviceToken pp t) = J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t
+  toJSON (APNSDeviceToken pp t) = J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t]
 
 instance FromJSON DeviceToken where
   parseJSON = J.withObject "DeviceToken" $ \o -> do
     pp <- strDecode . encodeUtf8 <$?> o .: "pushProvider"
     t <- encodeUtf8 <$> o .: "token"
-    pure $ DeviceToken pp t
+    pure $ APNSDeviceToken pp t
 
 -- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
 -- because strEncode of NonEmpty list uses comma for separator,
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 76dca88f9e..859cbe1428 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -629,7 +629,7 @@ showServer' = decodeLatin1 . strEncode . host
 
 ntfPush :: NtfPushServer -> M ()
 ntfPush s@NtfPushServer {pushQ} = forever $ do
-  (srvHost_, tkn@NtfTknRec {ntfTknId, token = t@(DeviceToken pp _), tknStatus}, ntf) <- atomically (readTBQueue pushQ)
+  (srvHost_, tkn@NtfTknRec {ntfTknId, token = t@(APNSDeviceToken pp _), tknStatus}, ntf) <- atomically (readTBQueue pushQ)
   liftIO $ logDebug $ "sending push notification to " <> T.pack (show pp)
   st <- asks store
   case ntf of
@@ -906,7 +906,7 @@ withNtfStore stAction continue = do
     Right a -> continue a
 
 incNtfStatT :: DeviceToken -> (NtfServerStats -> IORef Int) -> M ()
-incNtfStatT (DeviceToken PPApnsNull _) _ = pure ()
+incNtfStatT (APNSDeviceToken PPApnsNull _) _ = pure ()
 incNtfStatT _ statSel = incNtfStat statSel
 {-# INLINE incNtfStatT #-}
 
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 2337fa7fda..b9b2700ceb 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -256,7 +256,7 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text}
 $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
 
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
-apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = DeviceToken _ tknStr} pn = do
+apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = APNSDeviceToken _ tknStr} pn = do
   http2 <- liftHTTPS2 $ getApnsHTTP2Client c
   nonce <- atomically $ C.randomCbNonce nonceDrg
   apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
diff --git a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
index b6f23047f8..0c86005101 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
@@ -126,7 +126,7 @@ insertNtfTknQuery =
   |]
 
 replaceNtfToken :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
-replaceNtfToken st NtfTknRec {ntfTknId, token = token@(DeviceToken pp ppToken), tknStatus, tknRegCode = code@(NtfRegCode regCode)} =
+replaceNtfToken st NtfTknRec {ntfTknId, token = token@(APNSDeviceToken pp ppToken), tknStatus, tknRegCode = code@(NtfRegCode regCode)} =
   withFastDB "replaceNtfToken" st $ \db -> runExceptT $ do
     ExceptT $ assertUpdated <$>
       DB.execute
@@ -141,7 +141,7 @@ replaceNtfToken st NtfTknRec {ntfTknId, token = token@(DeviceToken pp ppToken),
 
 ntfTknToRow :: NtfTknRec -> NtfTknRow
 ntfTknToRow NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt} =
-  let DeviceToken pp ppToken = token
+  let APNSDeviceToken pp ppToken = token
       NtfRegCode regCode = tknRegCode
    in (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt)
 
@@ -151,7 +151,7 @@ getNtfToken st tknId =
     getNtfToken_ st " WHERE token_id = ?" (Only tknId)
 
 findNtfTokenRegistration :: NtfPostgresStore -> NewNtfEntity 'Token -> IO (Either ErrorType (Maybe NtfTknRec))
-findNtfTokenRegistration st (NewNtfTkn (DeviceToken pp ppToken) tknVerifyKey _) =
+findNtfTokenRegistration st (NewNtfTkn (APNSDeviceToken pp ppToken) tknVerifyKey _) =
   getNtfToken_ st " WHERE push_provider = ? AND push_provider_token = ? AND verify_key = ?" (pp, Binary ppToken, tknVerifyKey)
 
 getNtfToken_ :: ToRow q => NtfPostgresStore -> Query -> q -> IO (Either ErrorType (Maybe NtfTknRec))
@@ -179,7 +179,7 @@ ntfTknQuery =
 
 rowToNtfTkn :: NtfTknRow -> NtfTknRec
 rowToNtfTkn (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt)  =
-  let token = DeviceToken pp ppToken
+  let token = APNSDeviceToken pp ppToken
       tknRegCode = NtfRegCode regCode
    in NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}
 
@@ -374,7 +374,7 @@ setTknStatusConfirmed st NtfTknRec {ntfTknId} =
     when (updated > 0) $ withLog "updateTknStatus" st $ \sl -> logTokenStatus sl ntfTknId NTConfirmed
 
 setTokenActive :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
-setTokenActive st tkn@NtfTknRec {ntfTknId, token = DeviceToken pp ppToken} =
+setTokenActive st tkn@NtfTknRec {ntfTknId, token = APNSDeviceToken pp ppToken} =
   withFastDB' "setTokenActive" st $ \db -> do
     updateTknStatus_ st db tkn NTActive
     -- this removes other instances of the same token, e.g. because of repeated token registration attempts
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index c7be1a3e28..acd4699a3b 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -218,7 +218,7 @@ runNtfTestCfg (t, msType) baseId smpCfg ntfCfg aCfg bCfg runTest = do
 testNotificationToken :: APNSMockServer -> IO ()
 testNotificationToken apns = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
-    let tkn = DeviceToken PPApnsTest "abcd"
+    let tkn = APNSDeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
@@ -242,7 +242,7 @@ v .-> key = do
 testNtfTokenRepeatRegistration :: APNSMockServer -> IO ()
 testNtfTokenRepeatRegistration apns = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
-    let tkn = DeviceToken PPApnsTest "abcd"
+    let tkn = APNSDeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
@@ -261,7 +261,7 @@ testNtfTokenRepeatRegistration apns = do
 testNtfTokenSecondRegistration :: APNSMockServer -> IO ()
 testNtfTokenSecondRegistration apns =
   withAgentClients2 $ \a a' -> runRight_ $ do
-    let tkn = DeviceToken PPApnsTest "abcd"
+    let tkn = APNSDeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
@@ -290,7 +290,7 @@ testNtfTokenSecondRegistration apns =
 
 testNtfTokenServerRestart :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestart t apns = do
-  let tkn = DeviceToken PPApnsTest "abcd"
+  let tkn = APNSDeviceToken PPApnsTest "abcd"
   ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -311,7 +311,7 @@ testNtfTokenServerRestart t apns = do
 
 testNtfTokenServerRestartReverify :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReverify t apns = do
-  let tkn = DeviceToken PPApnsTest "abcd"
+  let tkn = APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a -> do
     ntfData <- withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -334,7 +334,7 @@ testNtfTokenServerRestartReverify t apns = do
 
 testNtfTokenServerRestartReverifyTimeout :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReverifyTimeout t apns = do
-  let tkn = DeviceToken PPApnsTest "abcd"
+  let tkn = APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     (nonce, verification) <- withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -369,7 +369,7 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
 
 testNtfTokenServerRestartReregister :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReregister t apns = do
-  let tkn = DeviceToken PPApnsTest "abcd"
+  let tkn = APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -393,7 +393,7 @@ testNtfTokenServerRestartReregister t apns = do
 
 testNtfTokenServerRestartReregisterTimeout :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReregisterTimeout t apns = do
-  let tkn = DeviceToken PPApnsTest "abcd"
+  let tkn = APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -434,7 +434,7 @@ getTestNtfTokenPort a =
 
 testNtfTokenMultipleServers :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenMultipleServers t apns = do
-  let tkn = DeviceToken PPApnsTest "abcd"
+  let tkn = APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers2 testDB $ \a ->
     withNtfServerThreadOn t ntfTestPort ntfTestDBCfg $ \ntf ->
       withNtfServerThreadOn t ntfTestPort2 ntfTestDBCfg2 $ \ntf2 -> runRight_ $ do
@@ -554,7 +554,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
     -- register notification token
-    let tkn = DeviceToken PPApnsTest "abcd"
+    let tkn = APNSDeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken alice tkn NMInstant
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
@@ -607,9 +607,9 @@ testNotificationSubscriptionNewConnection :: HasCallStack => APNSMockServer -> A
 testNotificationSubscriptionNewConnection apns baseId alice bob =
   runRight_ $ do
     -- alice registers notification token
-    DeviceToken {} <- registerTestToken alice "abcd" NMInstant apns
+    APNSDeviceToken {} <- registerTestToken alice "abcd" NMInstant apns
     -- bob registers notification token
-    DeviceToken {} <- registerTestToken bob "bcde" NMInstant apns
+    APNSDeviceToken {} <- registerTestToken bob "bcde" NMInstant apns
     -- establish connection
     liftIO $ threadDelay 50000
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -645,7 +645,7 @@ testNotificationSubscriptionNewConnection apns baseId alice bob =
 
 registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> APNSMockServer -> ExceptT AgentErrorType IO DeviceToken
 registerTestToken a token mode apns = do
-  let tkn = DeviceToken PPApnsTest token
+  let tkn = APNSDeviceToken PPApnsTest token
   NTRegistered <- registerNtfToken a tkn mode
   Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
     timeout 1000000 $ getMockNotification apns tkn
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index 30b648401c..bd833446c3 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -293,7 +293,7 @@ getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
           sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body"
 
 getMockNotification :: MonadIO m => APNSMockServer -> DeviceToken -> m APNSMockRequest
-getMockNotification APNSMockServer {notifications} (DeviceToken _ token) = do
+getMockNotification APNSMockServer {notifications} (APNSDeviceToken _ token) = do
   atomically $ TM.lookup token notifications >>= maybe retry readTBQueue
 
 getAnyMockNotification :: MonadIO m => APNSMockServer -> m APNSMockRequest
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index a4f0a7d626..c4dd72b24b 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -107,7 +107,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
     (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-    let tkn = DeviceToken PPApnsTest "abcd"
+    let tkn = APNSDeviceToken PPApnsTest "abcd"
     withAPNSMockServer $ \apns ->
       smpTest2 t msType $ \rh sh ->
         ntfTest t $ \nh -> do
@@ -160,7 +160,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           (msgBody, "hello") #== "delivered from queue"
           Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, ACK mId1)
           -- replace token
-          let tkn' = DeviceToken PPApnsTest "efgh"
+          let tkn' = APNSDeviceToken PPApnsTest "efgh"
           RespNtf "7" tId' NROk <- signSendRecvNtf nh tknKey ("7", tId, TRPL tkn')
           tId `shouldBe` tId'
           APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
@@ -237,7 +237,7 @@ registerToken nh apns token = do
   g <- C.newRandom
   (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-  let tkn = DeviceToken PPApnsTest token
+  let tkn = APNSDeviceToken PPApnsTest token
   RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
   APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
     getMockNotification apns tkn

From 64269c212afa83255b8a273e8cc03157a7d15f75 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Wed, 27 Aug 2025 10:56:06 +0200
Subject: [PATCH 04/26] Add WPDeviceToken

---
 .../Messaging/Agent/Store/AgentStore.hs       | 27 ++++--
 .../Messaging/Notifications/Protocol.hs       | 93 +++++++++++++++++--
 src/Simplex/Messaging/Notifications/Server.hs |  3 +-
 .../Messaging/Notifications/Server/Env.hs     |  1 +
 .../Notifications/Server/Push/APNS.hs         |  7 +-
 .../Notifications/Server/Store/Postgres.hs    | 13 ++-
 6 files changed, 119 insertions(+), 25 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
index e19c34f32a..3911a2eba9 100644
--- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs
+++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
@@ -278,7 +278,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), Ratc
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..))
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..), deviceTokenFields, deviceToken')
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol
@@ -1382,7 +1382,8 @@ deleteCommand db cmdId =
   DB.execute db "DELETE FROM commands WHERE command_id = ?" (Only cmdId)
 
 createNtfToken :: DB.Connection -> NtfToken -> IO ()
-createNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} = do
+createNtfToken db NtfToken {deviceToken, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} = do
+  let (provider, token) = deviceTokenFields deviceToken
   upsertNtfServer_ db srv
   DB.execute
     db
@@ -1409,10 +1410,12 @@ getSavedNtfToken db = do
       let ntfServer = NtfServer host port keyHash
           ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
           ntfMode = fromMaybe NMPeriodic ntfMode_
-       in NtfToken {deviceToken = APNSDeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
+          deviceToken = deviceToken' provider dt
+       in NtfToken {deviceToken, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
 
 updateNtfTokenRegistration :: DB.Connection -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> IO ()
-updateNtfTokenRegistration db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret = do
+updateNtfTokenRegistration db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret = do
+  let (provider, token) = deviceTokenFields deviceToken
   updatedAt <- getCurrentTime
   DB.execute
     db
@@ -1424,8 +1427,10 @@ updateNtfTokenRegistration db NtfToken {deviceToken = APNSDeviceToken provider t
     (tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
 
 updateDeviceToken :: DB.Connection -> NtfToken -> DeviceToken -> IO ()
-updateDeviceToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} (APNSDeviceToken toProvider toToken) = do
+updateDeviceToken db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} toDt = do
+  let (provider, token) = deviceTokenFields deviceToken
   updatedAt <- getCurrentTime
+  let (toProvider, toToken) = deviceTokenFields toDt
   DB.execute
     db
     [sql|
@@ -1436,7 +1441,8 @@ updateDeviceToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntf
     (toProvider, toToken, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
 
 updateNtfMode :: DB.Connection -> NtfToken -> NotificationsMode -> IO ()
-updateNtfMode db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} ntfMode = do
+updateNtfMode db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} ntfMode = do
+  let (provider, token) = deviceTokenFields deviceToken
   updatedAt <- getCurrentTime
   DB.execute
     db
@@ -1448,7 +1454,8 @@ updateNtfMode db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServ
     (ntfMode, updatedAt, provider, token, host, port)
 
 updateNtfToken :: DB.Connection -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> IO ()
-updateNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknStatus tknAction = do
+updateNtfToken db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} tknStatus tknAction = do
+  let (provider, token) = deviceTokenFields deviceToken
   updatedAt <- getCurrentTime
   DB.execute
     db
@@ -1460,7 +1467,8 @@ updateNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfSer
     (tknStatus, tknAction, updatedAt, provider, token, host, port)
 
 removeNtfToken :: DB.Connection -> NtfToken -> IO ()
-removeNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} =
+removeNtfToken db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} = do
+  let (provider, token) = deviceTokenFields deviceToken
   DB.execute
     db
     [sql|
@@ -1785,7 +1793,8 @@ getActiveNtfToken db =
       let ntfServer = NtfServer host port keyHash
           ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
           ntfMode = fromMaybe NMPeriodic ntfMode_
-       in NtfToken {deviceToken = APNSDeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
+          deviceToken = deviceToken' provider dt
+       in NtfToken {deviceToken, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode}
 
 getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, Int64, RcvNtfDhSecret, Maybe UTCTime))
 getNtfRcvQueue db SMPQueueNtf {smpServer = (SMPServer host port _), notifierId} =
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 1c7bf5cff6..4806c3dddb 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -35,6 +35,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
+import Control.Monad (when)
 
 data NtfEntity = Token | Subscription
   deriving (Show)
@@ -377,6 +378,7 @@ data PushProvider
   | PPApnsProd -- production environment, including TestFlight
   | PPApnsTest -- used for tests, to use APNS mock server
   | PPApnsNull -- used to test servers from the client - does not communicate with APNS
+  | PPWebPush -- used for webpush (FCM, UnifiedPush, potentially desktop)
   deriving (Eq, Ord, Show)
 
 instance Encoding PushProvider where
@@ -385,12 +387,14 @@ instance Encoding PushProvider where
     PPApnsProd -> "AP"
     PPApnsTest -> "AT"
     PPApnsNull -> "AN"
+    PPWebPush -> "WP"
   smpP =
     A.take 2 >>= \case
       "AD" -> pure PPApnsDev
       "AP" -> pure PPApnsProd
       "AT" -> pure PPApnsTest
       "AN" -> pure PPApnsNull
+      "WP" -> pure PPWebPush
       _ -> fail "bad PushProvider"
 
 instance StrEncoding PushProvider where
@@ -399,45 +403,116 @@ instance StrEncoding PushProvider where
     PPApnsProd -> "apns_prod"
     PPApnsTest -> "apns_test"
     PPApnsNull -> "apns_null"
+    PPWebPush -> "webpush"
   strP =
     A.takeTill (== ' ') >>= \case
       "apns_dev" -> pure PPApnsDev
       "apns_prod" -> pure PPApnsProd
       "apns_test" -> pure PPApnsTest
       "apns_null" -> pure PPApnsNull
+      "webpush" -> pure PPWebPush
       _ -> fail "bad PushProvider"
 
 instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
 
 instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode
 
+data WPEndpoint = WPEndpoint { endpoint::ByteString, auth::ByteString, p256dh::ByteString }
+  deriving (Eq, Ord, Show)
+
+instance Encoding WPEndpoint where
+  smpEncode WPEndpoint { endpoint, auth, p256dh } = smpEncode (endpoint, auth, p256dh)
+  smpP = do
+    endpoint <- smpP
+    auth <- smpP
+    p256dh <- smpP
+    pure WPEndpoint { endpoint, auth, p256dh }
+
+instance StrEncoding WPEndpoint where
+  strEncode WPEndpoint { endpoint, auth, p256dh } = endpoint <> " " <> strEncode auth <> " " <> strEncode p256dh
+  strP = do
+    endpoint <- A.takeWhile (/= ' ')
+    _ <- A.char ' '
+    (auth, p256dh) <- strP
+    -- auth is a 16 bytes long random key
+    when (B.length auth /= 16) $ fail "Invalid auth key length"
+    -- p256dh is a public key on the P-256 curve, encoded in uncompressed format
+    -- 0x04 + the 2 points = 65 bytes
+    when (B.length p256dh /= 65) $ fail "Invalid p256dh key length"
+    when (B.take 1 p256dh /= "\x04") $ fail "Invalid p256dh key, doesn't start with 0x04"
+    pure WPEndpoint { endpoint, auth, p256dh }
+
+instance ToJSON WPEndpoint where
+  toEncoding WPEndpoint { endpoint, auth, p256dh } = J.pairs $ "endpoint" .= decodeLatin1 endpoint <> "auth" .= decodeLatin1 (strEncode auth) <> "p256dh" .= decodeLatin1 (strEncode p256dh)
+  toJSON WPEndpoint { endpoint, auth, p256dh } = J.object ["endpoint" .= decodeLatin1 endpoint, "auth" .= decodeLatin1 (strEncode auth), "p256dh" .= decodeLatin1 (strEncode p256dh) ]
+
+instance FromJSON WPEndpoint where
+  parseJSON = J.withObject "WPEndpoint" $ \o -> do
+    endpoint <- encodeUtf8 <$> o .: "endpoint"
+    auth <- strDecode . encodeUtf8 <$?> o .: "auth"
+    p256dh <- strDecode . encodeUtf8 <$?> o .: "p256dh"
+    pure WPEndpoint { endpoint, auth, p256dh }
+
 data DeviceToken
   = APNSDeviceToken PushProvider ByteString
+  | WPDeviceToken WPEndpoint
   deriving (Eq, Ord, Show)
 
 instance Encoding DeviceToken where
-  smpEncode (APNSDeviceToken p t) = smpEncode (p, t)
-  smpP = APNSDeviceToken <$> smpP <*> smpP
+  smpEncode token = case token of
+    APNSDeviceToken p t -> smpEncode (p, t)
+    WPDeviceToken t -> smpEncode (PPWebPush, t)
+  smpP = do
+    pp <- smpP
+    case pp of
+      PPWebPush -> WPDeviceToken <$> smpP
+      _ -> APNSDeviceToken pp <$> smpP
 
 instance StrEncoding DeviceToken where
-  strEncode (APNSDeviceToken p t) = strEncode p <> " " <> t
-  strP = nullToken <|> hexToken
+  strEncode token = case token of
+    APNSDeviceToken p t -> strEncode p <> " " <> t
+    WPDeviceToken t -> strEncode PPWebPush <> " " <> strEncode t
+  strP = nullToken <|> deviceToken
     where
       nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token"
-      hexToken = APNSDeviceToken <$> strP <* A.space <*> hexStringP
+      deviceToken = do
+        pp <- strP_
+        case pp of
+          PPWebPush -> WPDeviceToken <$> strP
+          _ -> APNSDeviceToken pp <$> hexStringP
       hexStringP =
         A.takeWhile (`B.elem` "0123456789abcdef") >>= \s ->
           if even (B.length s) then pure s else fail "odd number of hex characters"
 
 instance ToJSON DeviceToken where
-  toEncoding (APNSDeviceToken pp t) = J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t
-  toJSON (APNSDeviceToken pp t) = J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t]
+  toEncoding token = case token of
+    APNSDeviceToken pp t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t
+    WPDeviceToken t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode PPWebPush) <> "token" .= toJSON t
+  toJSON token = case token of
+    APNSDeviceToken pp t -> J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t]
+    WPDeviceToken t -> J.object ["pushProvider" .= decodeLatin1 (strEncode PPWebPush), "token" .= toJSON t]
 
 instance FromJSON DeviceToken where
   parseJSON = J.withObject "DeviceToken" $ \o -> do
     pp <- strDecode . encodeUtf8 <$?> o .: "pushProvider"
-    t <- encodeUtf8 <$> o .: "token"
-    pure $ APNSDeviceToken pp t
+    case pp of
+      PPWebPush -> do
+        WPDeviceToken <$> (o .: "token")
+      _ -> do
+        t <- encodeUtf8 <$> (o .: "token")
+        pure $ APNSDeviceToken pp t
+
+-- | Returns fields for the device token (pushProvider, token)
+deviceTokenFields :: DeviceToken -> (PushProvider, ByteString)
+deviceTokenFields dt = case dt of
+      APNSDeviceToken pp t -> (pp, t)
+      WPDeviceToken t -> (PPWebPush, strEncode t)
+
+-- | Returns the device token from the fields (pushProvider, token)
+deviceToken' :: PushProvider -> ByteString -> DeviceToken
+deviceToken' pp t = case pp of
+      PPWebPush -> WPDeviceToken <$> either error id $ strDecode t
+      _ -> APNSDeviceToken pp t
 
 -- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
 -- because strEncode of NonEmpty list uses comma for separator,
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 859cbe1428..1529065214 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -629,7 +629,8 @@ showServer' = decodeLatin1 . strEncode . host
 
 ntfPush :: NtfPushServer -> M ()
 ntfPush s@NtfPushServer {pushQ} = forever $ do
-  (srvHost_, tkn@NtfTknRec {ntfTknId, token = t@(APNSDeviceToken pp _), tknStatus}, ntf) <- atomically (readTBQueue pushQ)
+  (srvHost_, tkn@NtfTknRec {ntfTknId, token = t, tknStatus}, ntf) <- atomically (readTBQueue pushQ)
+  let (pp, _) = deviceTokenFields t
   liftIO $ logDebug $ "sending push notification to " <> T.pack (show pp)
   st <- asks store
   case ntf of
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 7ed258b9a0..33a8a194a1 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -25,6 +25,7 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..))
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Push
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore)
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index b9b2700ceb..b01c68ce0b 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -130,6 +130,7 @@ apnsProviderHost = \case
   PPApnsTest -> Just "localhost"
   PPApnsDev -> Just "api.sandbox.push.apple.com"
   PPApnsProd -> Just "api.push.apple.com"
+  _ -> Nothing
 
 defaultAPNSPushClientConfig :: APNSPushClientConfig
 defaultAPNSPushClientConfig =
@@ -256,7 +257,8 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text}
 $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
 
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
-apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = APNSDeviceToken _ tknStr} pn = do
+apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token} pn = do
+  tknStr <- deviceToken token
   http2 <- liftHTTPS2 $ getApnsHTTP2Client c
   nonce <- atomically $ C.randomCbNonce nonceDrg
   apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
@@ -270,6 +272,9 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token
     else logWarn $ "APNS error: " <> T.pack (show status) <> " " <> reason' <> apnsIds response
   result status reason'
   where
+    deviceToken t = case t of
+      APNSDeviceToken _ dt -> pure dt
+      _ -> throwE PPInvalidPusher
     apnsIds response = headerStr "apns-id" <> headerStr "apns-unique-id"
       where
         headerStr name =
diff --git a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
index 0c86005101..e7e16b6f5d 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
@@ -126,8 +126,9 @@ insertNtfTknQuery =
   |]
 
 replaceNtfToken :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
-replaceNtfToken st NtfTknRec {ntfTknId, token = token@(APNSDeviceToken pp ppToken), tknStatus, tknRegCode = code@(NtfRegCode regCode)} =
+replaceNtfToken st NtfTknRec {ntfTknId, token, tknStatus, tknRegCode = code@(NtfRegCode regCode)} =
   withFastDB "replaceNtfToken" st $ \db -> runExceptT $ do
+    let (pp, ppToken) = deviceTokenFields token
     ExceptT $ assertUpdated <$>
       DB.execute
         db
@@ -141,7 +142,7 @@ replaceNtfToken st NtfTknRec {ntfTknId, token = token@(APNSDeviceToken pp ppToke
 
 ntfTknToRow :: NtfTknRec -> NtfTknRow
 ntfTknToRow NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt} =
-  let APNSDeviceToken pp ppToken = token
+  let (pp, ppToken) = deviceTokenFields token
       NtfRegCode regCode = tknRegCode
    in (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt)
 
@@ -151,7 +152,8 @@ getNtfToken st tknId =
     getNtfToken_ st " WHERE token_id = ?" (Only tknId)
 
 findNtfTokenRegistration :: NtfPostgresStore -> NewNtfEntity 'Token -> IO (Either ErrorType (Maybe NtfTknRec))
-findNtfTokenRegistration st (NewNtfTkn (APNSDeviceToken pp ppToken) tknVerifyKey _) =
+findNtfTokenRegistration st (NewNtfTkn token tknVerifyKey _) = do
+  let (pp, ppToken) = deviceTokenFields token
   getNtfToken_ st " WHERE push_provider = ? AND push_provider_token = ? AND verify_key = ?" (pp, Binary ppToken, tknVerifyKey)
 
 getNtfToken_ :: ToRow q => NtfPostgresStore -> Query -> q -> IO (Either ErrorType (Maybe NtfTknRec))
@@ -179,7 +181,7 @@ ntfTknQuery =
 
 rowToNtfTkn :: NtfTknRow -> NtfTknRec
 rowToNtfTkn (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt)  =
-  let token = APNSDeviceToken pp ppToken
+  let token = deviceToken' pp ppToken
       tknRegCode = NtfRegCode regCode
    in NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}
 
@@ -374,8 +376,9 @@ setTknStatusConfirmed st NtfTknRec {ntfTknId} =
     when (updated > 0) $ withLog "updateTknStatus" st $ \sl -> logTokenStatus sl ntfTknId NTConfirmed
 
 setTokenActive :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
-setTokenActive st tkn@NtfTknRec {ntfTknId, token = APNSDeviceToken pp ppToken} =
+setTokenActive st tkn@NtfTknRec {ntfTknId, token} =
   withFastDB' "setTokenActive" st $ \db -> do
+    let (pp, ppToken) = deviceTokenFields token
     updateTknStatus_ st db tkn NTActive
     -- this removes other instances of the same token, e.g. because of repeated token registration attempts
     tknIds <-

From a24024c0b87d30595711f7522a3a70bdf896fb30 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Wed, 16 Jul 2025 16:51:39 +0200
Subject: [PATCH 05/26] Prepare webpush requests

---
 simplexmq.cabal                               |  3 +
 src/Simplex/Messaging/Notifications/Server.hs |  1 +
 .../Messaging/Notifications/Server/Env.hs     | 19 ++++-
 .../Messaging/Notifications/Server/Push.hs    |  5 ++
 .../Notifications/Server/Push/WebPush.hs      | 74 +++++++++++++++++++
 5 files changed, 101 insertions(+), 1 deletion(-)
 create mode 100644 src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index dc56e4ff3d..710d6409ce 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -259,6 +259,7 @@ library
               Simplex.Messaging.Notifications.Server.Main
               Simplex.Messaging.Notifications.Server.Prometheus
               Simplex.Messaging.Notifications.Server.Push.APNS
+              Simplex.Messaging.Notifications.Server.Push.WebPush
               Simplex.Messaging.Notifications.Server.Push
               Simplex.Messaging.Notifications.Server.Push.APNS.Internal
               Simplex.Messaging.Notifications.Server.Stats
@@ -303,6 +304,8 @@ library
     , directory ==1.3.*
     , filepath ==1.4.*
     , hourglass ==0.2.*
+    , http-client ==0.7.*
+    , http-client-tls ==0.3.6.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
     , iproute ==1.7.*
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 1529065214..aca4e44a0b 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -677,6 +677,7 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
             err e
           PPPermanentError -> err e
           PPInvalidPusher -> err e
+          _ -> err e
       where
         retryDeliver :: IO (Either PushProviderError ())
         retryDeliver = do
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 33a8a194a1..0e1507668e 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -47,6 +47,9 @@ import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
 import Simplex.Messaging.Notifications.Server.Push (PushNotification, PushProviderClient)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient)
+import Network.HTTP.Client (newManager)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
 
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ASrvTransport, AddHTTP)],
@@ -161,13 +164,27 @@ newNtfPushServer qSize apnsConfig = do
   pure NtfPushServer {pushQ, pushClients, apnsConfig}
 
 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
-newPushClient NtfPushServer {apnsConfig, pushClients} pp = do
+newPushClient s pp = do
+  case pp of
+    PPWebPush -> newWPPushClient s
+    _ -> newAPNSPushClient s pp
+
+newAPNSPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
+newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do
   c <- case apnsProviderHost pp of
     Nothing -> pure $ \_ _ -> pure ()
     Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig
   atomically $ TM.insert pp c pushClients
   pure c
 
+newWPPushClient :: NtfPushServer -> IO PushProviderClient
+newWPPushClient NtfPushServer {pushClients} = do
+  logDebug "New WP Client requested"
+  manager <- newManager tlsManagerSettings
+  let c = wpPushProviderClient manager
+  atomically $ TM.insert PPWebPush c pushClients
+  pure c
+
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 getPushClient s@NtfPushServer {pushClients} pp =
   TM.lookupIO pp pushClients >>= maybe (newPushClient s pp) pure
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index 3c7e57c6ab..a2a954b085 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -36,6 +36,7 @@ import Network.HTTP.Types (Status)
 import Control.Exception (Exception)
 import Simplex.Messaging.Notifications.Server.Store.Types (NtfTknRec)
 import Control.Monad.Except (ExceptT)
+import GHC.Exception (SomeException)
 
 data JWTHeader = JWTHeader
   { alg :: Text, -- key algorithm, ES256 for APNS
@@ -94,6 +95,10 @@ data PushProviderError
   | PPRetryLater
   | PPPermanentError
   | PPInvalidPusher
+  | PPWPInvalidUrl
+  | PPWPRemovedEndpoint
+  | PPWPRequestTooLong
+  | PPWPOtherError SomeException
   deriving (Show, Exception)
 
 type PushProviderClient = NtfTknRec -> PushNotification -> ExceptT PushProviderError IO ()
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
new file mode 100644
index 0000000000..6457d2b84c
--- /dev/null
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use newtype instead of data" #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Simplex.Messaging.Notifications.Server.Push.WebPush where
+
+import Network.HTTP.Client
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken), WPEndpoint (..))
+import Simplex.Messaging.Notifications.Server.Store.Types
+import Simplex.Messaging.Notifications.Server.Push
+import Control.Monad.Except
+import Control.Logger.Simple (logDebug)
+import Simplex.Messaging.Util (tshow)
+import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Char8 (ByteString)
+import Control.Monad.IO.Class (liftIO)
+import Control.Exception ( fromException, SomeException, try )
+import qualified Network.HTTP.Types as N
+
+wpPushProviderClient :: Manager -> PushProviderClient
+wpPushProviderClient mg tkn _ = do
+      e <- B.unpack <$> endpoint tkn
+      r <- liftPPWPError $ parseUrlThrow e
+      logDebug $ "Request to " <> tshow r.host
+      let requestHeaders = [
+            ("TTL", "2592000") -- 30 days
+            , ("Urgency", "High")
+            , ("Content-Encoding", "aes128gcm")
+        -- TODO: topic for pings and interval
+            ]
+      let req = r {
+        method = "POST"
+        , requestHeaders
+        , requestBody = "ping"
+        , redirectCount = 0
+      }
+      _ <- liftPPWPError $ httpNoBody req mg
+      pure ()
+  where
+    endpoint :: NtfTknRec -> ExceptT PushProviderError IO ByteString
+    endpoint NtfTknRec {token} = do
+      case token of
+        WPDeviceToken WPEndpoint{ endpoint = e } -> pure e
+        _ -> fail "Wrong device token"
+
+liftPPWPError :: IO a -> ExceptT PushProviderError IO a
+liftPPWPError = liftPPWPError' toPPWPError
+
+liftPPWPError' :: (SomeException -> PushProviderError) -> IO a -> ExceptT PushProviderError IO a
+liftPPWPError' err a = do
+  res <- liftIO $ try @SomeException a
+  either (throwError . err) return res
+
+toPPWPError :: SomeException -> PushProviderError
+toPPWPError e = case fromException e of
+    Just (InvalidUrlException _ _) -> PPWPInvalidUrl
+    Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (responseStatus resp) ("" :: String)
+    _ -> PPWPOtherError e
+  where
+    fromStatusCode status reason
+      | status == N.status200 = PPWPRemovedEndpoint
+      | status == N.status410 = PPWPRemovedEndpoint
+      | status == N.status413 = PPWPRequestTooLong
+      | status == N.status429 = PPRetryLater
+      | status >= N.status500 = PPRetryLater
+      | otherwise = PPResponseError (Just status) (tshow reason)

From 2205a1fb7ccec2b15a3b4ffb2faaf92c13e25dfb Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Wed, 16 Jul 2025 18:13:48 +0200
Subject: [PATCH 06/26] Use content of push notif with web push

---
 .../Notifications/Server/Push/WebPush.hs      | 24 +++++++++++++++----
 1 file changed, 19 insertions(+), 5 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 6457d2b84c..625113c75d 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -13,20 +13,25 @@
 module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
 import Network.HTTP.Client
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken), WPEndpoint (..))
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken), WPEndpoint (..), encodePNMessages, PNMessageData)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
 import Control.Logger.Simple (logDebug)
 import Simplex.Messaging.Util (tshow)
 import qualified Data.ByteString.Char8 as B
-import Data.ByteString.Char8 (ByteString)
 import Control.Monad.IO.Class (liftIO)
 import Control.Exception ( fromException, SomeException, try )
 import qualified Network.HTTP.Types as N
+import qualified Data.Aeson as J
+import Data.Aeson ((.=))
+import qualified Data.ByteString.Lazy as BL
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.Text.Encoding as T
+import qualified Data.Text as T
 
 wpPushProviderClient :: Manager -> PushProviderClient
-wpPushProviderClient mg tkn _ = do
+wpPushProviderClient mg tkn pn = do
       e <- B.unpack <$> endpoint tkn
       r <- liftPPWPError $ parseUrlThrow e
       logDebug $ "Request to " <> tshow r.host
@@ -39,18 +44,27 @@ wpPushProviderClient mg tkn _ = do
       let req = r {
         method = "POST"
         , requestHeaders
-        , requestBody = "ping"
+        , requestBody = RequestBodyLBS $ encodePN pn
         , redirectCount = 0
       }
       _ <- liftPPWPError $ httpNoBody req mg
       pure ()
   where
-    endpoint :: NtfTknRec -> ExceptT PushProviderError IO ByteString
+    endpoint :: NtfTknRec -> ExceptT PushProviderError IO B.ByteString
     endpoint NtfTknRec {token} = do
       case token of
         WPDeviceToken WPEndpoint{ endpoint = e } -> pure e
         _ -> fail "Wrong device token"
 
+encodePN :: PushNotification -> BL.ByteString
+encodePN pn = J.encode $ case pn of
+    PNVerification code -> J.object [ "verification" .= code ]
+    PNMessage d -> J.object [ "message" .= encodeData d ]
+    PNCheckMessages -> J.object [ "checkMessages" .= True ]
+  where
+    encodeData :: NonEmpty PNMessageData -> String
+    encodeData a = T.unpack . T.decodeUtf8 $ encodePNMessages a
+
 liftPPWPError :: IO a -> ExceptT PushProviderError IO a
 liftPPWPError = liftPPWPError' toPPWPError
 

From 1295b2829882a07ecd660357348d5f209bd34204 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 18 Jul 2025 10:16:33 +0200
Subject: [PATCH 07/26] Lint liftPPWPError

---
 src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 625113c75d..bdb2745a64 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -69,9 +69,7 @@ liftPPWPError :: IO a -> ExceptT PushProviderError IO a
 liftPPWPError = liftPPWPError' toPPWPError
 
 liftPPWPError' :: (SomeException -> PushProviderError) -> IO a -> ExceptT PushProviderError IO a
-liftPPWPError' err a = do
-  res <- liftIO $ try @SomeException a
-  either (throwError . err) return res
+liftPPWPError' err a = liftIO (try @SomeException a) >>= either (throwError . err) return
 
 toPPWPError :: SomeException -> PushProviderError
 toPPWPError e = case fromException e of

From 720fb40a861157c81afd4b9997b36fc899746679 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 18 Jul 2025 10:17:08 +0200
Subject: [PATCH 08/26] Encrypt wp notifications

---
 simplexmq.cabal                               |   1 +
 src/Simplex/Messaging/Crypto.hs               |  22 +++-
 .../Notifications/Server/Push/WebPush.hs      | 104 +++++++++++++++++-
 3 files changed, 120 insertions(+), 7 deletions(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 710d6409ce..54fb464d3c 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -292,6 +292,7 @@ library
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
+    , binary ==0.8.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index ed1363b469..a540bd0373 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -127,6 +127,7 @@ module Simplex.Messaging.Crypto
     encryptAEAD,
     decryptAEAD,
     encryptAESNoPad,
+    encryptAES128NoPad,
     decryptAESNoPad,
     authTagSize,
     randomAesKey,
@@ -209,7 +210,7 @@ import Control.Exception (Exception)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Trans.Except
-import Crypto.Cipher.AES (AES256)
+import Crypto.Cipher.AES (AES256, AES128)
 import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
@@ -895,6 +896,8 @@ data CryptoError
     CERatchetEarlierMessage Word32
   | -- | duplicate message number
     CERatchetDuplicateMessage
+  | -- | unable to decode ecc key
+    CryptoInvalidECCKey CE.CryptoError
   deriving (Eq, Show, Exception)
 
 aesKeySize :: Int
@@ -1021,11 +1024,22 @@ encryptAESNoPad :: Key -> GCMIV -> ByteString -> ExceptT CryptoError IO (AuthTag
 encryptAESNoPad key iv = encryptAEADNoPad key iv ""
 {-# INLINE encryptAESNoPad #-}
 
+-- Used to encrypt WebPush notifications
+-- This function requires 12 bytes IV, it does not transform IV.
+encryptAES128NoPad :: Key -> GCMIV -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
+encryptAES128NoPad key iv = encryptAEAD128NoPad key iv ""
+{-# INLINE encryptAES128NoPad #-}
+
 encryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
 encryptAEADNoPad aesKey ivBytes ad msg = do
   aead <- initAEADGCM aesKey ivBytes
   pure . first AuthTag $ AES.aeadSimpleEncrypt aead ad msg authTagSize
 
+encryptAEAD128NoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
+encryptAEAD128NoPad aesKey ivBytes ad msg = do
+  aead <- initAEAD128GCM aesKey ivBytes
+  pure . first AuthTag $ AES.aeadSimpleEncrypt aead ad msg authTagSize
+
 -- | AEAD-GCM decryption with associated data.
 --
 -- Used as part of double ratchet encryption.
@@ -1125,6 +1139,12 @@ initAEADGCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
   cipher <- AES.cipherInit aesKey
   AES.aeadInit AES.AEAD_GCM cipher ivBytes
 
+-- this function requires 12 bytes IV, it does not transforms IV.
+initAEAD128GCM :: Key -> GCMIV -> ExceptT CryptoError IO (AES.AEAD AES128)
+initAEAD128GCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
+  cipher <- AES.cipherInit aesKey
+  AES.aeadInit AES.AEAD_GCM cipher ivBytes
+
 -- | Random AES256 key.
 randomAesKey :: TVar ChaChaDRG -> STM Key
 randomAesKey = fmap Key . randomBytes aesKeySize
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index bdb2745a64..51e571df3c 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -9,10 +9,12 @@
 {-# HLINT ignore "Use newtype instead of data" #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
 import Network.HTTP.Client
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken), WPEndpoint (..), encodePNMessages, PNMessageData)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
@@ -25,36 +27,126 @@ import Control.Exception ( fromException, SomeException, try )
 import qualified Network.HTTP.Types as N
 import qualified Data.Aeson as J
 import Data.Aeson ((.=))
+import qualified Data.Binary as Bin
+import qualified Data.Bits as Bits
+import qualified Data.ByteArray as BA
 import qualified Data.ByteString.Lazy as BL
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Text.Encoding as T
 import qualified Data.Text as T
+import Control.Monad.Trans.Except (throwE)
+import Crypto.Hash.Algorithms (SHA256)
+import Crypto.Random (MonadRandom(getRandomBytes))
+import qualified Crypto.Cipher.Types as CT
+import qualified Crypto.Error as CE
+import qualified Crypto.MAC.HMAC as HMAC
+import qualified Crypto.PubKey.ECC.DH as ECDH
+import qualified Crypto.PubKey.ECC.Types as ECC
+import GHC.Base (when)
 
 wpPushProviderClient :: Manager -> PushProviderClient
 wpPushProviderClient mg tkn pn = do
-      e <- B.unpack <$> endpoint tkn
-      r <- liftPPWPError $ parseUrlThrow e
+      e <- endpoint tkn
+      r <- liftPPWPError $ parseUrlThrow $ B.unpack e.endpoint
       logDebug $ "Request to " <> tshow r.host
+      encBody <- body e
       let requestHeaders = [
             ("TTL", "2592000") -- 30 days
             , ("Urgency", "High")
             , ("Content-Encoding", "aes128gcm")
         -- TODO: topic for pings and interval
             ]
-      let req = r {
+          req = r {
         method = "POST"
         , requestHeaders
-        , requestBody = RequestBodyLBS $ encodePN pn
+        , requestBody = RequestBodyBS encBody
         , redirectCount = 0
       }
       _ <- liftPPWPError $ httpNoBody req mg
       pure ()
   where
-    endpoint :: NtfTknRec -> ExceptT PushProviderError IO B.ByteString
+    endpoint :: NtfTknRec -> ExceptT PushProviderError IO WPEndpoint
     endpoint NtfTknRec {token} = do
       case token of
-        WPDeviceToken WPEndpoint{ endpoint = e } -> pure e
+        WPDeviceToken e -> pure e
         _ -> fail "Wrong device token"
+    -- TODO: move to PPIndalidPusher ? WPEndpoint should be invalidated and removed if the key is invalid, but the validation key is never sent
+    body :: WPEndpoint -> ExceptT PushProviderError IO B.ByteString
+    body e = withExceptT PPCryptoError $ wpEncrypt e.auth e.p256dh (BL.toStrict $ encodePN pn)
+
+-- | encrypt :: auth -> key -> clear -> cipher
+-- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
+wpEncrypt :: B.ByteString -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
+wpEncrypt auth uaPubKS clearT = do
+  salt :: B.ByteString <- liftIO $ getRandomBytes 16
+  asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1
+  uaPubK <- point uaPubKS
+  let asPubK = BL.toStrict . uncompressEncode . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
+      ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK
+      prkKey = hmac auth ecdhSecret
+      keyInfo = "WebPush: info\0" <> uaPubKS <> asPubK
+      ikm = hmac prkKey (keyInfo <> "\x01")
+      prk = hmac salt ikm
+      cekInfo = "Content-Encoding: aes128gcm\0" :: B.ByteString
+      cek = takeHM 16 $ hmac prk (cekInfo <> "\x01")
+      nonceInfo = "Content-Encoding: nonce\0" :: B.ByteString
+      nonce = takeHM 12 $ hmac prk (nonceInfo <> "\x01")
+      rs = BL.toStrict $ Bin.encode (4096 :: Bin.Word32) -- with RFC8291, it's ok to always use 4096 because there is only one single record and the final record can be smaller than rs (RFC8188)
+      idlen = BL.toStrict $ Bin.encode (65 :: Bin.Word8) -- with RFC8291, keyid is the pubkey, so always 65 bytes
+      header = salt <> rs <> idlen <> asPubK
+  iv <- ivFrom nonce
+  -- The last record uses a padding delimiter octet set to the value 0x02
+  (C.AuthTag (CT.AuthTag tag), cipherT) <- C.encryptAES128NoPad (C.Key cek) iv $ clearT <> "\x02"
+  pure $ header <> cipherT <> BA.convert tag
+  where
+    point :: B.ByteString -> ExceptT C.CryptoError IO ECC.Point
+    point s = withExceptT C.CryptoInvalidECCKey $ uncompressDecode $ BL.fromStrict s
+    hmac k v = HMAC.hmac k v :: HMAC.HMAC SHA256
+    takeHM :: Int -> HMAC.HMAC SHA256 -> B.ByteString
+    takeHM n v = BL.toStrict $ BL.pack $ take n $ BA.unpack v
+    ivFrom :: B.ByteString -> ExceptT C.CryptoError IO C.GCMIV
+    ivFrom s = case C.gcmIV s of
+      Left e -> throwE e
+      Right iv -> pure iv
+
+-- | Elliptic-Curve-Point-to-Octet-String Conversion without compression
+-- | as required by RFC8291
+-- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3
+uncompressEncode :: ECC.Point -> BL.ByteString
+uncompressEncode (ECC.Point x y) = "\x04" <>
+                                     encodeBigInt x <>
+                                     encodeBigInt y
+uncompressEncode ECC.PointO = "\0"
+
+uncompressDecode :: BL.ByteString -> ExceptT CE.CryptoError IO ECC.Point
+uncompressDecode "\0" = pure ECC.PointO
+uncompressDecode s = do
+  when (BL.take 1 s /= prefix) $ throwError CE.CryptoError_PointFormatUnsupported
+  when (BL.length s /= 65) $ throwError CE.CryptoError_KeySizeInvalid
+  let s' = BL.drop 1 s
+  x <- decodeBigInt $ BL.take 32 s'
+  y <- decodeBigInt $ BL.drop 32 s'
+  pure $ ECC.Point x y
+  where
+    prefix = "\x04" :: BL.ByteString
+
+encodeBigInt :: Integer -> BL.ByteString
+encodeBigInt i = do
+  let s1 = Bits.shiftR i 64
+      s2 = Bits.shiftR s1 64
+      s3 = Bits.shiftR s2 64
+  Bin.encode ( w64 s3, w64 s2, w64 s1, w64 i )
+  where
+    w64 :: Integer -> Bin.Word64
+    w64 = fromIntegral
+
+decodeBigInt :: BL.ByteString -> ExceptT CE.CryptoError IO Integer
+decodeBigInt s = do
+  when (BL.length s /= 32) $ throwError CE.CryptoError_PointSizeInvalid
+  let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 )
+  pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0
+  where
+    shift i w = Bits.shiftL (fromIntegral w) (64*i)
 
 encodePN :: PushNotification -> BL.ByteString
 encodePN pn = J.encode $ case pn of

From 9d30af4edddd5d5c57c0b510a5cf6ff18771bf0d Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Mon, 18 Aug 2025 14:12:46 +0200
Subject: [PATCH 09/26] Fix Urgency case

---
 src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 51e571df3c..3ece66d2c7 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -52,7 +52,7 @@ wpPushProviderClient mg tkn pn = do
       encBody <- body e
       let requestHeaders = [
             ("TTL", "2592000") -- 30 days
-            , ("Urgency", "High")
+            , ("Urgency", "high")
             , ("Content-Encoding", "aes128gcm")
         -- TODO: topic for pings and interval
             ]

From f5a8d8b21cb00e1a8aae81bebbb4cc12efbcf18c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 16 Sep 2025 21:29:38 +0100
Subject: [PATCH 10/26] token types and migration (WIP, does not compile)

---
 simplexmq.cabal                               |   5 +-
 src/Simplex/Messaging/Crypto.hs               |   2 +-
 .../Messaging/Notifications/Protocol.hs       | 137 +++++++++++-------
 .../Messaging/Notifications/Server/Env.hs     |   1 -
 .../Notifications/Server/Push/APNS.hs         |   4 +-
 .../Notifications/Server/Push/WebPush.hs      |  72 ++++-----
 .../Notifications/Server/Store/Migrations.hs  |  34 ++++-
 src/Simplex/Messaging/Protocol.hs             |  10 +-
 8 files changed, 173 insertions(+), 92 deletions(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 402d750db0..1ff3878627 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -261,7 +261,6 @@ library
               Simplex.Messaging.Notifications.Server.Push
               Simplex.Messaging.Notifications.Server.Push.APNS
               Simplex.Messaging.Notifications.Server.Push.WebPush
-              Simplex.Messaging.Notifications.Server.Push
               Simplex.Messaging.Notifications.Server.Push.APNS.Internal
               Simplex.Messaging.Notifications.Server.Stats
               Simplex.Messaging.Notifications.Server.Store
@@ -307,8 +306,6 @@ library
     , directory ==1.3.*
     , filepath ==1.4.*
     , hourglass ==0.2.*
-    , http-client ==0.7.*
-    , http-client-tls ==0.3.6.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
     , iproute ==1.7.*
@@ -340,6 +337,8 @@ library
         case-insensitive ==1.2.*
       , hashable ==1.4.*
       , ini ==0.4.1
+      , http-client ==0.7.*
+      , http-client-tls ==0.3.6.*
       , optparse-applicative >=0.15 && <0.17
       , process ==1.6.*
       , temporary ==1.3.*
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index a540bd0373..46d8dd10ac 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -897,7 +897,7 @@ data CryptoError
   | -- | duplicate message number
     CERatchetDuplicateMessage
   | -- | unable to decode ecc key
-    CryptoInvalidECCKey CE.CryptoError
+    CryptoInvalidECCKey CE.CryptoError -- TODO [webpush] remove this error, it will be parsing error
   deriving (Eq, Show, Exception)
 
 aesKeySize :: Int
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 4806c3dddb..1b074be438 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -12,6 +12,8 @@
 module Simplex.Messaging.Notifications.Protocol where
 
 import Control.Applicative (optional, (<|>))
+import Control.Monad
+import qualified Crypto.PubKey.ECC.Types as ECC
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
@@ -35,7 +37,6 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
-import Control.Monad (when)
 
 data NtfEntity = Token | Subscription
   deriving (Show)
@@ -373,63 +374,102 @@ instance StrEncoding SMPQueueNtf where
     notifierId <- A.char '/' *> strP
     pure SMPQueueNtf {smpServer, notifierId}
 
-data PushProvider
+data PushProvider = PPAPNS APNSProvider | PPWP WPProvider
+  deriving (Eq, Ord, Show)
+
+data APNSProvider
   = PPApnsDev -- provider for Apple development environment
   | PPApnsProd -- production environment, including TestFlight
   | PPApnsTest -- used for tests, to use APNS mock server
   | PPApnsNull -- used to test servers from the client - does not communicate with APNS
-  | PPWebPush -- used for webpush (FCM, UnifiedPush, potentially desktop)
+  deriving (Eq, Ord, Show)
+
+newtype WPProvider = WPP (ProtocolServer 'PHTTPS)
   deriving (Eq, Ord, Show)
 
 instance Encoding PushProvider where
+  smpEncode = \case
+    PPAPNS p -> smpEncode p
+    PPWP p -> smpEncode p
+  smpP =
+    A.peekChar' >>= \case
+      'A' -> PPAPNS <$> smpP
+      _ -> PPWP <$> smpP
+
+instance Encoding APNSProvider where
   smpEncode = \case
     PPApnsDev -> "AD"
     PPApnsProd -> "AP"
     PPApnsTest -> "AT"
     PPApnsNull -> "AN"
-    PPWebPush -> "WP"
   smpP =
     A.take 2 >>= \case
       "AD" -> pure PPApnsDev
       "AP" -> pure PPApnsProd
       "AT" -> pure PPApnsTest
       "AN" -> pure PPApnsNull
-      "WP" -> pure PPWebPush
-      _ -> fail "bad PushProvider"
+      _ -> fail "bad APNSProvider"
 
 instance StrEncoding PushProvider where
+  strEncode = \case
+    PPAPNS p -> strEncode p
+    PPWP p -> strEncode p
+  strP =
+    A.peekChar' >>= \case
+      'a' -> PPAPNS <$> strP
+      _ -> PPWP <$> strP
+
+instance StrEncoding APNSProvider where
   strEncode = \case
     PPApnsDev -> "apns_dev"
     PPApnsProd -> "apns_prod"
     PPApnsTest -> "apns_test"
     PPApnsNull -> "apns_null"
-    PPWebPush -> "webpush"
   strP =
     A.takeTill (== ' ') >>= \case
       "apns_dev" -> pure PPApnsDev
       "apns_prod" -> pure PPApnsProd
       "apns_test" -> pure PPApnsTest
       "apns_null" -> pure PPApnsNull
-      "webpush" -> pure PPWebPush
-      _ -> fail "bad PushProvider"
+      _ -> fail "bad APNSProvider"
+
+instance Encoding WPProvider where
+  smpEncode (WPP srv) = "WP" <> smpEncode srv
+  smpP = WPP <$> ("WP" *> smpP)
+
+instance StrEncoding WPProvider where
+  strEncode (WPP srv) = "webpush " <> strEncode srv
+  strP = WPP <$> ("webpush " *> strP)
 
-instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+instance FromField APNSProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
 
-instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode
+instance ToField APNSProvider where toField = toField . decodeLatin1 . strEncode
+
+data WPTokenParams = WPTokenParams
+  { wpPath :: Text, -- parser should validate it's a valid type
+    wpAuth :: ByteString, -- if we enforce size constraints, should also be in parser.
+    wpKey :: WPKey -- or another correct type that is needed for encryption, so it fails in parser and not there
+  }
 
-data WPEndpoint = WPEndpoint { endpoint::ByteString, auth::ByteString, p256dh::ByteString }
+newtype WPKey =  WPKey ECC.Point
+
+data WPEndpoint = WPEndpoint
+  { endpoint :: ByteString,
+    auth :: ByteString,
+    p256dh :: ByteString
+  }
   deriving (Eq, Ord, Show)
 
 instance Encoding WPEndpoint where
-  smpEncode WPEndpoint { endpoint, auth, p256dh } = smpEncode (endpoint, auth, p256dh)
+  smpEncode WPEndpoint {endpoint, auth, p256dh} = smpEncode (endpoint, auth, p256dh)
   smpP = do
     endpoint <- smpP
     auth <- smpP
     p256dh <- smpP
-    pure WPEndpoint { endpoint, auth, p256dh }
+    pure WPEndpoint {endpoint, auth, p256dh}
 
 instance StrEncoding WPEndpoint where
-  strEncode WPEndpoint { endpoint, auth, p256dh } = endpoint <> " " <> strEncode auth <> " " <> strEncode p256dh
+  strEncode WPEndpoint {endpoint, auth, p256dh} = endpoint <> " " <> strEncode auth <> " " <> strEncode p256dh
   strP = do
     endpoint <- A.takeWhile (/= ' ')
     _ <- A.char ' '
@@ -439,80 +479,79 @@ instance StrEncoding WPEndpoint where
     -- p256dh is a public key on the P-256 curve, encoded in uncompressed format
     -- 0x04 + the 2 points = 65 bytes
     when (B.length p256dh /= 65) $ fail "Invalid p256dh key length"
+    -- TODO [webpush] parse it here (or rather in WPTokenParams)
     when (B.take 1 p256dh /= "\x04") $ fail "Invalid p256dh key, doesn't start with 0x04"
-    pure WPEndpoint { endpoint, auth, p256dh }
+    pure WPEndpoint {endpoint, auth, p256dh}
 
 instance ToJSON WPEndpoint where
-  toEncoding WPEndpoint { endpoint, auth, p256dh } = J.pairs $ "endpoint" .= decodeLatin1 endpoint <> "auth" .= decodeLatin1 (strEncode auth) <> "p256dh" .= decodeLatin1 (strEncode p256dh)
-  toJSON WPEndpoint { endpoint, auth, p256dh } = J.object ["endpoint" .= decodeLatin1 endpoint, "auth" .= decodeLatin1 (strEncode auth), "p256dh" .= decodeLatin1 (strEncode p256dh) ]
+  toEncoding WPEndpoint {endpoint, auth, p256dh} = J.pairs $ "endpoint" .= decodeLatin1 endpoint <> "auth" .= decodeLatin1 (strEncode auth) <> "p256dh" .= decodeLatin1 (strEncode p256dh)
+  toJSON WPEndpoint {endpoint, auth, p256dh} = J.object ["endpoint" .= decodeLatin1 endpoint, "auth" .= decodeLatin1 (strEncode auth), "p256dh" .= decodeLatin1 (strEncode p256dh) ]
 
 instance FromJSON WPEndpoint where
   parseJSON = J.withObject "WPEndpoint" $ \o -> do
     endpoint <- encodeUtf8 <$> o .: "endpoint"
     auth <- strDecode . encodeUtf8 <$?> o .: "auth"
     p256dh <- strDecode . encodeUtf8 <$?> o .: "p256dh"
-    pure WPEndpoint { endpoint, auth, p256dh }
+    pure WPEndpoint {endpoint, auth, p256dh}
 
 data DeviceToken
-  = APNSDeviceToken PushProvider ByteString
-  | WPDeviceToken WPEndpoint
+  = APNSDeviceToken APNSProvider ByteString
+  | WPDeviceToken WPProvider WPEndpoint
+  -- TODO [webpush] replace with WPTokenParams
+  -- | WPDeviceToken WPProvider WPTokenParams
   deriving (Eq, Ord, Show)
 
 instance Encoding DeviceToken where
   smpEncode token = case token of
     APNSDeviceToken p t -> smpEncode (p, t)
-    WPDeviceToken t -> smpEncode (PPWebPush, t)
-  smpP = do
-    pp <- smpP
-    case pp of
-      PPWebPush -> WPDeviceToken <$> smpP
-      _ -> APNSDeviceToken pp <$> smpP
+    WPDeviceToken p t -> smpEncode (p, t)
+  smpP =
+    smpP >>= \case
+      PPAPNS p -> APNSDeviceToken p <$> smpP
+      PPWP p -> WPDeviceToken p <$> smpP
 
 instance StrEncoding DeviceToken where
   strEncode token = case token of
     APNSDeviceToken p t -> strEncode p <> " " <> t
-    WPDeviceToken t -> strEncode PPWebPush <> " " <> strEncode t
+    WPDeviceToken p t -> strEncode (p, t)
   strP = nullToken <|> deviceToken
     where
       nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token"
-      deviceToken = do
-        pp <- strP_
-        case pp of
-          PPWebPush -> WPDeviceToken <$> strP
-          _ -> APNSDeviceToken pp <$> hexStringP
+      deviceToken =
+        strP_ >>= \case
+          PPAPNS p -> APNSDeviceToken p <$> hexStringP
+          PPWP p -> WPDeviceToken p <$> strP
       hexStringP =
         A.takeWhile (`B.elem` "0123456789abcdef") >>= \s ->
           if even (B.length s) then pure s else fail "odd number of hex characters"
 
+-- TODO [webpush] is it needed?
 instance ToJSON DeviceToken where
   toEncoding token = case token of
-    APNSDeviceToken pp t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t
-    WPDeviceToken t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode PPWebPush) <> "token" .= toJSON t
+    APNSDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= decodeLatin1 t
+    WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t
   toJSON token = case token of
-    APNSDeviceToken pp t -> J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t]
-    WPDeviceToken t -> J.object ["pushProvider" .= decodeLatin1 (strEncode PPWebPush), "token" .= toJSON t]
+    APNSDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= decodeLatin1 t]
+    WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t]
 
 instance FromJSON DeviceToken where
-  parseJSON = J.withObject "DeviceToken" $ \o -> do
-    pp <- strDecode . encodeUtf8 <$?> o .: "pushProvider"
-    case pp of
-      PPWebPush -> do
-        WPDeviceToken <$> (o .: "token")
-      _ -> do
-        t <- encodeUtf8 <$> (o .: "token")
-        pure $ APNSDeviceToken pp t
+  parseJSON = J.withObject "DeviceToken" $ \o ->
+    (strDecode . encodeUtf8 <$?> o .: "pushProvider") >>= \case
+      PPAPNS p -> APNSDeviceToken p . encodeUtf8 <$> (o .: "token")
+      PPWP p -> WPDeviceToken p <$> (o .: "token")
 
 -- | Returns fields for the device token (pushProvider, token)
+-- TODO [webpush] save token as separate fields
 deviceTokenFields :: DeviceToken -> (PushProvider, ByteString)
 deviceTokenFields dt = case dt of
-      APNSDeviceToken pp t -> (pp, t)
-      WPDeviceToken t -> (PPWebPush, strEncode t)
+  APNSDeviceToken p t -> (PPAPNS p, t)
+  WPDeviceToken p t -> (PPWP p, strEncode t)
 
 -- | Returns the device token from the fields (pushProvider, token)
 deviceToken' :: PushProvider -> ByteString -> DeviceToken
 deviceToken' pp t = case pp of
-      PPWebPush -> WPDeviceToken <$> either error id $ strDecode t
-      _ -> APNSDeviceToken pp t
+  PPAPNS p -> APNSDeviceToken p t
+  PPWP p -> WPDeviceToken p <$> either error id $ strDecode t
 
 -- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
 -- because strEncode of NonEmpty list uses comma for separator,
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 0e1507668e..a4b2fca6e5 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -46,7 +46,6 @@ import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, Transport
 import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
-import Simplex.Messaging.Notifications.Server.Push (PushNotification, PushProviderClient)
 import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient)
 import Network.HTTP.Client (newManager)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index b01c68ce0b..ebe2238307 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -124,13 +124,12 @@ data APNSPushClientConfig = APNSPushClientConfig
     caStoreFile :: FilePath
   }
 
-apnsProviderHost :: PushProvider -> Maybe HostName
+apnsProviderHost :: APNSProvider -> Maybe HostName
 apnsProviderHost = \case
   PPApnsNull -> Nothing
   PPApnsTest -> Just "localhost"
   PPApnsDev -> Just "api.sandbox.push.apple.com"
   PPApnsProd -> Just "api.push.apple.com"
-  _ -> Nothing
 
 defaultAPNSPushClientConfig :: APNSPushClientConfig
 defaultAPNSPushClientConfig =
@@ -256,6 +255,7 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text}
 
 $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
 
+-- TODO [webpush] change type accept token components so it only allows APNS token
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
 apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token} pn = do
   tknStr <- deviceToken token
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 3ece66d2c7..be681b0348 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -3,13 +3,11 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
 {-# HLINT ignore "Use newtype instead of data" #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
@@ -46,33 +44,36 @@ import GHC.Base (when)
 
 wpPushProviderClient :: Manager -> PushProviderClient
 wpPushProviderClient mg tkn pn = do
-      e <- endpoint tkn
-      r <- liftPPWPError $ parseUrlThrow $ B.unpack e.endpoint
-      logDebug $ "Request to " <> tshow r.host
-      encBody <- body e
-      let requestHeaders = [
-            ("TTL", "2592000") -- 30 days
-            , ("Urgency", "high")
-            , ("Content-Encoding", "aes128gcm")
-        -- TODO: topic for pings and interval
-            ]
-          req = r {
-        method = "POST"
-        , requestHeaders
-        , requestBody = RequestBodyBS encBody
-        , redirectCount = 0
-      }
-      _ <- liftPPWPError $ httpNoBody req mg
-      pure ()
+  -- TODO [webpush] parsing will happen in DeviceToken parser, so it won't fail here
+  -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
+  wpe@WPEndpoint {endpoint} <- tokenEndpoint tkn
+  r <- liftPPWPError $ parseUrlThrow $ B.unpack endpoint
+  logDebug $ "Request to " <> tshow (host r)
+  encBody <- body wpe
+  let requestHeaders =
+        [ ("TTL", "2592000"), -- 30 days
+          ("Urgency", "high"),
+          ("Content-Encoding", "aes128gcm")
+    -- TODO: topic for pings and interval
+        ]
+      req =
+        r
+          { method = "POST",
+            requestHeaders,
+            requestBody = RequestBodyBS encBody,
+            redirectCount = 0
+          }
+  _ <- liftPPWPError $ httpNoBody req mg
+  pure ()
   where
-    endpoint :: NtfTknRec -> ExceptT PushProviderError IO WPEndpoint
-    endpoint NtfTknRec {token} = do
+    tokenEndpoint :: NtfTknRec -> ExceptT PushProviderError IO WPEndpoint
+    tokenEndpoint NtfTknRec {token} = do
       case token of
-        WPDeviceToken e -> pure e
+        WPDeviceToken _p e -> pure e
         _ -> fail "Wrong device token"
     -- TODO: move to PPIndalidPusher ? WPEndpoint should be invalidated and removed if the key is invalid, but the validation key is never sent
     body :: WPEndpoint -> ExceptT PushProviderError IO B.ByteString
-    body e = withExceptT PPCryptoError $ wpEncrypt e.auth e.p256dh (BL.toStrict $ encodePN pn)
+    body WPEndpoint {auth, p256dh} = withExceptT PPCryptoError $ wpEncrypt auth p256dh (BL.toStrict $ encodePN pn)
 
 -- | encrypt :: auth -> key -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
@@ -80,6 +81,7 @@ wpEncrypt :: B.ByteString -> B.ByteString -> B.ByteString -> ExceptT C.CryptoErr
 wpEncrypt auth uaPubKS clearT = do
   salt :: B.ByteString <- liftIO $ getRandomBytes 16
   asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1
+  -- TODO [webpush] key parsing will happen in DeviceToken parser, so it won't fail here
   uaPubK <- point uaPubKS
   let asPubK = BL.toStrict . uncompressEncode . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
       ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK
@@ -112,12 +114,12 @@ wpEncrypt auth uaPubKS clearT = do
 -- | Elliptic-Curve-Point-to-Octet-String Conversion without compression
 -- | as required by RFC8291
 -- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3
+-- TODO [webpush] add them to the encoding of WPKey
 uncompressEncode :: ECC.Point -> BL.ByteString
-uncompressEncode (ECC.Point x y) = "\x04" <>
-                                     encodeBigInt x <>
-                                     encodeBigInt y
+uncompressEncode (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y
 uncompressEncode ECC.PointO = "\0"
 
+-- TODO [webpush] should be -> Either ... (which it would be in StrEncoding)
 uncompressDecode :: BL.ByteString -> ExceptT CE.CryptoError IO ECC.Point
 uncompressDecode "\0" = pure ECC.PointO
 uncompressDecode s = do
@@ -135,24 +137,26 @@ encodeBigInt i = do
   let s1 = Bits.shiftR i 64
       s2 = Bits.shiftR s1 64
       s3 = Bits.shiftR s2 64
-  Bin.encode ( w64 s3, w64 s2, w64 s1, w64 i )
+  Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
   where
     w64 :: Integer -> Bin.Word64
     w64 = fromIntegral
 
+-- TODO [webpush] should be -> Either ... (which it would be in StrEncoding)
 decodeBigInt :: BL.ByteString -> ExceptT CE.CryptoError IO Integer
 decodeBigInt s = do
   when (BL.length s /= 32) $ throwError CE.CryptoError_PointSizeInvalid
   let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 )
   pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0
   where
-    shift i w = Bits.shiftL (fromIntegral w) (64*i)
+    shift i w = Bits.shiftL (fromIntegral w) (64 * i)
 
+-- TODO [webpush] use ToJSON
 encodePN :: PushNotification -> BL.ByteString
 encodePN pn = J.encode $ case pn of
-    PNVerification code -> J.object [ "verification" .= code ]
-    PNMessage d -> J.object [ "message" .= encodeData d ]
-    PNCheckMessages -> J.object [ "checkMessages" .= True ]
+  PNVerification code -> J.object ["verification" .= code]
+  PNMessage d -> J.object ["message" .= encodeData d]
+  PNCheckMessages -> J.object ["checkMessages" .= True]
   where
     encodeData :: NonEmpty PNMessageData -> String
     encodeData a = T.unpack . T.decodeUtf8 $ encodePNMessages a
diff --git a/src/Simplex/Messaging/Notifications/Server/Store/Migrations.hs b/src/Simplex/Messaging/Notifications/Server/Store/Migrations.hs
index 226a02dc6e..5758e64a3d 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/Migrations.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store/Migrations.hs
@@ -12,7 +12,8 @@ import Text.RawString.QQ (r)
 ntfServerSchemaMigrations :: [(String, Text, Maybe Text)]
 ntfServerSchemaMigrations =
   [ ("20250417_initial", m20250417_initial, Nothing),
-    ("20250517_service_cert", m20250517_service_cert, Just down_m20250517_service_cert)
+    ("20250517_service_cert", m20250517_service_cert, Just down_m20250517_service_cert),
+    ("20250916_webpush", m20250916_webpush, Just down_m20250916_webpush)
   ]
 
 -- | The list of migrations in ascending order by date
@@ -104,3 +105,34 @@ ALTER TABLE smp_servers DROP COLUMN ntf_service_id;
 
 ALTER TABLE subscriptions DROP COLUMN ntf_service_assoc;
     |]
+
+m20250916_webpush :: Text
+m20250916_webpush =
+  T.pack
+    [r|
+CREATE TABLE webpush_servers(
+  wp_server_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
+  wp_host TEXT NOT NULL,
+  wp_port TEXT NOT NULL,
+  wp_keyhash BYTEA NOT NULL
+);
+
+ALTER TABLE tokens
+  ADD COLUMN wp_server_id BIGINT REFERENCES webpush_servers ON DELETE RESTRICT ON UPDATE RESTRICT,
+  ADD COLUMN wp_path TEXT,
+  ADD COLUMN wp_auth BYTEA,
+  ADD COLUMN wp_key BYTEA;
+    |]
+
+down_m20250916_webpush :: Text
+down_m20250916_webpush =
+  T.pack
+    [r|
+ALTER TABLE tokens
+  DROP COLUMN wp_server_id,
+  DROP COLUMN wp_path,
+  DROP COLUMN wp_auth,
+  DROP COLUMN wp_key;
+
+DROP TABLE webpush_servers;
+    |]
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 40314ad2af..7249ac1d25 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -1144,7 +1144,7 @@ sameSrvAddr :: ProtocolServer p -> ProtocolServer p -> Bool
 sameSrvAddr ProtocolServer {host, port} ProtocolServer {host = h', port = p'} = host == h' && port == p'
 {-# INLINE sameSrvAddr #-}
 
-data ProtocolType = PSMP | PNTF | PXFTP
+data ProtocolType = PSMP | PNTF | PXFTP | PHTTPS
   deriving (Eq, Ord, Show)
 
 instance StrEncoding ProtocolType where
@@ -1152,17 +1152,20 @@ instance StrEncoding ProtocolType where
     PSMP -> "smp"
     PNTF -> "ntf"
     PXFTP -> "xftp"
+    PHTTPS -> "https"
   strP =
     A.takeTill (\c -> c == ':' || c == ' ') >>= \case
       "smp" -> pure PSMP
       "ntf" -> pure PNTF
       "xftp" -> pure PXFTP
+      "https" -> pure PHTTPS
       _ -> fail "bad ProtocolType"
 
 data SProtocolType (p :: ProtocolType) where
   SPSMP :: SProtocolType 'PSMP
   SPNTF :: SProtocolType 'PNTF
   SPXFTP :: SProtocolType 'PXFTP
+  SPHTTPS :: SProtocolType 'PHTTPS
 
 deriving instance Eq (SProtocolType p)
 
@@ -1181,6 +1184,7 @@ instance TestEquality SProtocolType where
   testEquality SPSMP SPSMP = Just Refl
   testEquality SPNTF SPNTF = Just Refl
   testEquality SPXFTP SPXFTP = Just Refl
+  testEquality SPHTTPS SPHTTPS = Just Refl
   testEquality _ _ = Nothing
 
 protocolType :: SProtocolType p -> ProtocolType
@@ -1188,12 +1192,14 @@ protocolType = \case
   SPSMP -> PSMP
   SPNTF -> PNTF
   SPXFTP -> PXFTP
+  SPHTTPS -> PHTTPS
 
 aProtocolType :: ProtocolType -> AProtocolType
 aProtocolType = \case
   PSMP -> AProtocolType SPSMP
   PNTF -> AProtocolType SPNTF
   PXFTP -> AProtocolType SPXFTP
+  PHTTPS -> AProtocolType SPHTTPS
 
 instance ProtocolTypeI p => StrEncoding (SProtocolType p) where
   strEncode = strEncode . protocolType
@@ -1231,6 +1237,8 @@ instance ProtocolTypeI 'PNTF where protocolTypeI = SPNTF
 
 instance ProtocolTypeI 'PXFTP where protocolTypeI = SPXFTP
 
+instance ProtocolTypeI 'PHTTPS where protocolTypeI = SPHTTPS
+
 type family UserProtocol (p :: ProtocolType) :: Constraint where
   UserProtocol PSMP = ()
   UserProtocol PXFTP = ()

From 5e28d4faba4a00b889bd89bbbe410c2429ba54a4 Mon Sep 17 00:00:00 2001
From: S1m <31284753+p1gp1g@users.noreply.github.com>
Date: Mon, 10 Nov 2025 20:45:16 +0000
Subject: [PATCH 11/26] [webpush] Parsing during registration (#1661)

* Parse WPDeviceToken during registration

* Clarify PPInvalidPusher with apnsPushProviderClient

* Use SrvLoc for webpush endpoints

* Remove unused WPEndpoint

* Test RFC8291 - webpush encryption - implementation

* Fix tests with -fserver_postgres

* Disable redirections with webpush

* Rename webpush tests, and move behind server_postgres flag

* Parse webpush endpoint with StrEncoding

* Fix rename webpush tests

* Lint import

* Test push notification encoding for webpush

* Test strDecoding invalid WPDeviceToken
---
 simplexmq.cabal                               |   1 +
 .../Messaging/Notifications/Protocol.hs       | 283 ++++++++++++++----
 .../Messaging/Notifications/Server/Env.hs     |  28 +-
 .../Notifications/Server/Push/APNS.hs         |   7 +-
 .../Notifications/Server/Push/WebPush.hs      |  97 ++----
 src/Simplex/Messaging/Protocol.hs             |  10 +-
 src/Simplex/Messaging/ServiceScheme.hs        |   7 +
 tests/AgentTests/NotificationTests.hs         |   4 +-
 tests/NtfClient.hs                            |   2 +
 tests/NtfWPTests.hs                           |  91 ++++++
 tests/Test.hs                                 |   2 +
 11 files changed, 373 insertions(+), 159 deletions(-)
 create mode 100644 tests/NtfWPTests.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 6c56c55750..57ceaa5991 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -514,6 +514,7 @@ test-suite simplexmq-test
           AgentTests.NotificationTests
           NtfClient
           NtfServerTests
+          NtfWPTests
           PostgresSchemaDump
   hs-source-dirs:
       tests
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 1b074be438..93d18389b2 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -12,14 +12,13 @@
 module Simplex.Messaging.Notifications.Protocol where
 
 import Control.Applicative (optional, (<|>))
-import Control.Monad
 import qualified Crypto.PubKey.ECC.Types as ECC
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString as S
 import Data.Functor (($>))
 import Data.Kind
 import Data.List.NonEmpty (NonEmpty (..))
@@ -28,7 +27,7 @@ import Data.Maybe (isNothing)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock.System
 import Data.Type.Equality
-import Data.Word (Word16)
+import Data.Word (Word8, Word16)
 import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
 import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
@@ -37,6 +36,11 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Binary as Bin
+import qualified Crypto.Error as CE
+import qualified Data.Bits as Bits
+import Network.HTTP.Client (Request, parseUrlThrow)
 
 data NtfEntity = Token | Subscription
   deriving (Show)
@@ -109,7 +113,7 @@ instance ProtocolMsgTag NtfCmdTag where
 instance NtfEntityI e => ProtocolMsgTag (NtfCommandTag e) where
   decodeTag s = decodeTag s >>= (\(NCT _ t) -> checkEntity' t)
 
-newtype NtfRegCode = NtfRegCode ByteString
+newtype NtfRegCode = NtfRegCode B.ByteString
   deriving (Eq, Show)
 
 instance Encoding NtfRegCode where
@@ -208,7 +212,7 @@ instance NtfEntityI e => ProtocolEncoding NTFVersion ErrorType (NtfCommand e) wh
     SDEL -> e SDEL_
     PING -> e PING_
     where
-      e :: Encoding a => a -> ByteString
+      e :: Encoding a => a -> B.ByteString
       e = smpEncode
 
   protocolP _v tag = (\(NtfCmd _ c) -> checkEntity c) <$?> protocolP _v (NCT (sNtfEntity @e) tag)
@@ -317,7 +321,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
     NRSub stat -> e (NRSub_, ' ', stat)
     NRPong -> e NRPong_
     where
-      e :: Encoding a => a -> ByteString
+      e :: Encoding a => a -> B.ByteString
       e = smpEncode
 
   protocolP _v = \case
@@ -384,7 +388,10 @@ data APNSProvider
   | PPApnsNull -- used to test servers from the client - does not communicate with APNS
   deriving (Eq, Ord, Show)
 
-newtype WPProvider = WPP (ProtocolServer 'PHTTPS)
+newtype WPSrvLoc = WPSrvLoc SrvLoc
+  deriving (Eq, Ord, Show)
+
+newtype WPProvider = WPP WPSrvLoc
   deriving (Eq, Ord, Show)
 
 instance Encoding PushProvider where
@@ -433,6 +440,14 @@ instance StrEncoding APNSProvider where
       "apns_null" -> pure PPApnsNull
       _ -> fail "bad APNSProvider"
 
+instance Encoding WPSrvLoc where
+  smpEncode (WPSrvLoc srv) = smpEncode srv
+  smpP = WPSrvLoc <$> smpP
+
+instance StrEncoding WPSrvLoc where
+  strEncode (WPSrvLoc srv) = "https://" <> strEncode srv
+  strP = WPSrvLoc <$> ("https://" *> strP)
+
 instance Encoding WPProvider where
   smpEncode (WPP srv) = "WP" <> smpEncode srv
   smpP = WPP <$> ("WP" *> smpP)
@@ -441,64 +456,187 @@ instance StrEncoding WPProvider where
   strEncode (WPP srv) = "webpush " <> strEncode srv
   strP = WPP <$> ("webpush " *> strP)
 
-instance FromField APNSProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
-
-instance ToField APNSProvider where toField = toField . decodeLatin1 . strEncode
+instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+
+instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode
+
+tupleToList16
+  :: (a,a,a,a,
+      a,a,a,a,
+      a,a,a,a,
+      a,a,a,a)
+  -> [a]
+tupleToList16
+  (a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15) =
+    [a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15]
+
+listToTuple16
+  :: [a]
+  -> Maybe (a,a,a,a,
+            a,a,a,a,
+            a,a,a,a,
+            a,a,a,a)
+listToTuple16
+  [a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15] =
+    Just (a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15)
+listToTuple16 _ = Nothing
+
+newtype Auth = Auth (Word8, Word8, Word8, Word8,
+                     Word8, Word8, Word8, Word8,
+                     Word8, Word8, Word8, Word8,
+                     Word8, Word8, Word8, Word8)
+
+instance Eq Auth where
+  (Auth t1) == (Auth t2) = tupleToList16 t1 == tupleToList16 t2
+
+instance Ord Auth where
+  compare (Auth t1) (Auth t2) = compare (tupleToList16 t1) (tupleToList16 t2)
+
+instance Show Auth where
+  show (Auth t) = "Auth " ++ show (tupleToList16 t)
+
+authFromByteString :: S.ByteString -> Maybe Auth
+authFromByteString bs = do
+  tup <- listToTuple16 $ S.unpack bs
+  pure (Auth tup)
+
+authToByteString :: Auth -> S.ByteString
+authToByteString (Auth a) = S.pack $ tupleToList16 a
+
+newtype WPP256dh = WPP256dh ECC.PublicPoint
+  deriving (Eq, Show)
 
-data WPTokenParams = WPTokenParams
-  { wpPath :: Text, -- parser should validate it's a valid type
-    wpAuth :: ByteString, -- if we enforce size constraints, should also be in parser.
-    wpKey :: WPKey -- or another correct type that is needed for encryption, so it fails in parser and not there
+instance Ord WPP256dh where
+  compare (WPP256dh p1) (WPP256dh p2) = comparePt p1 p2
+    where
+      comparePt ECC.PointO ECC.PointO = EQ
+      comparePt ECC.PointO (ECC.Point _ _) = LT
+      comparePt (ECC.Point _ _) ECC.PointO = GT
+      comparePt (ECC.Point x1 y1)  (ECC.Point x2 y2) = compare (x1, y1) (x2, y2)
+
+data WPKey = WPKey
+  { wpAuth :: Auth,
+    wpP256dh :: WPP256dh
   }
+  deriving (Eq, Ord, Show)
 
-newtype WPKey =  WPKey ECC.Point
+-- | Elliptic-Curve-Point-to-Octet-String Conversion without compression
+-- | as required by RFC8291
+-- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3
+uncompressEncodePoint :: ECC.Point -> BL.ByteString
+uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y
+uncompressEncodePoint ECC.PointO = "\0"
+
+uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point
+uncompressDecodePoint "\0" = pure ECC.PointO
+uncompressDecodePoint s
+  | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported
+  | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid
+  | otherwise = do
+    let s' = BL.drop 1 s
+    x <- decodeBigInt $ BL.take 32 s'
+    y <- decodeBigInt $ BL.drop 32 s'
+    pure $ ECC.Point x y
+  where
+    prefix = "\x04" :: BL.ByteString
+
+-- Used to test encryption against the RFC8291 Example - which gives the AS private key
+uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber
+uncompressDecodePrivateNumber s
+  | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid
+  | otherwise = do
+    decodeBigInt s
+
+uncompressEncode :: WPP256dh -> BL.ByteString
+uncompressEncode (WPP256dh p) = uncompressEncodePoint p
+
+uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh
+uncompressDecode bs = WPP256dh <$> uncompressDecodePoint bs
+
+encodeBigInt :: Integer -> BL.ByteString
+encodeBigInt i = do
+  let s1 = Bits.shiftR i 64
+      s2 = Bits.shiftR s1 64
+      s3 = Bits.shiftR s2 64
+  Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
+  where
+    w64 :: Integer -> Bin.Word64
+    w64 = fromIntegral
+
+decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer
+decodeBigInt s
+  | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid
+  | otherwise = do
+      let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 )
+      pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0
+  where
+    shift i w = Bits.shiftL (fromIntegral w) (64 * i)
 
-data WPEndpoint = WPEndpoint
-  { endpoint :: ByteString,
-    auth :: ByteString,
-    p256dh :: ByteString
+data WPTokenParams = WPTokenParams
+  { wpPath :: B.ByteString,
+    wpKey :: WPKey
   }
   deriving (Eq, Ord, Show)
 
-instance Encoding WPEndpoint where
-  smpEncode WPEndpoint {endpoint, auth, p256dh} = smpEncode (endpoint, auth, p256dh)
+instance Encoding Auth where
+  smpEncode a = smpEncode $ authToByteString a
+  smpP = smpP >>= \bs ->
+    case authFromByteString bs of
+      Nothing -> fail "Invalid auth"
+      Just a -> pure a
+
+instance StrEncoding Auth where
+  strEncode a = strEncode $ authToByteString a
+  strP = strP >>= \bs ->
+    case authFromByteString bs of
+      Nothing -> fail "Invalid auth"
+      Just a -> pure a
+
+instance Encoding WPP256dh where
+  smpEncode p = smpEncode . BL.toStrict $ uncompressEncode p
+  smpP = smpP >>= \bs ->
+    case uncompressDecode (BL.fromStrict bs) of
+      Left _ -> fail "Invalid p256dh key"
+      Right res -> pure res
+
+instance StrEncoding WPP256dh where
+  strEncode p = strEncode . BL.toStrict $ uncompressEncode p
+  strP = strP >>= \bs ->
+    case uncompressDecode (BL.fromStrict bs) of
+      Left _ -> fail "Invalid p256dh key"
+      Right res -> pure res
+
+instance Encoding WPKey where
+  smpEncode WPKey {wpAuth, wpP256dh} = smpEncode (wpAuth, wpP256dh)
   smpP = do
-    endpoint <- smpP
-    auth <- smpP
-    p256dh <- smpP
-    pure WPEndpoint {endpoint, auth, p256dh}
+    wpAuth <- smpP
+    wpP256dh <- smpP
+    pure WPKey {wpAuth, wpP256dh}
 
-instance StrEncoding WPEndpoint where
-  strEncode WPEndpoint {endpoint, auth, p256dh} = endpoint <> " " <> strEncode auth <> " " <> strEncode p256dh
+instance StrEncoding WPKey where
+  strEncode WPKey {wpAuth, wpP256dh} = strEncode (wpAuth, wpP256dh)
   strP = do
-    endpoint <- A.takeWhile (/= ' ')
+    (wpAuth, wpP256dh) <- strP
+    pure WPKey {wpAuth, wpP256dh}
+
+instance Encoding WPTokenParams where
+  smpEncode WPTokenParams {wpPath, wpKey} = smpEncode (wpPath, wpKey)
+  smpP = do
+    wpPath <- smpP
+    wpKey <- smpP
+    pure WPTokenParams {wpPath, wpKey}
+
+instance StrEncoding WPTokenParams where
+  strEncode WPTokenParams {wpPath, wpKey} = wpPath <> " " <> strEncode wpKey
+  strP = do
+    wpPath <- A.takeWhile (/= ' ')
     _ <- A.char ' '
-    (auth, p256dh) <- strP
-    -- auth is a 16 bytes long random key
-    when (B.length auth /= 16) $ fail "Invalid auth key length"
-    -- p256dh is a public key on the P-256 curve, encoded in uncompressed format
-    -- 0x04 + the 2 points = 65 bytes
-    when (B.length p256dh /= 65) $ fail "Invalid p256dh key length"
-    -- TODO [webpush] parse it here (or rather in WPTokenParams)
-    when (B.take 1 p256dh /= "\x04") $ fail "Invalid p256dh key, doesn't start with 0x04"
-    pure WPEndpoint {endpoint, auth, p256dh}
-
-instance ToJSON WPEndpoint where
-  toEncoding WPEndpoint {endpoint, auth, p256dh} = J.pairs $ "endpoint" .= decodeLatin1 endpoint <> "auth" .= decodeLatin1 (strEncode auth) <> "p256dh" .= decodeLatin1 (strEncode p256dh)
-  toJSON WPEndpoint {endpoint, auth, p256dh} = J.object ["endpoint" .= decodeLatin1 endpoint, "auth" .= decodeLatin1 (strEncode auth), "p256dh" .= decodeLatin1 (strEncode p256dh) ]
-
-instance FromJSON WPEndpoint where
-  parseJSON = J.withObject "WPEndpoint" $ \o -> do
-    endpoint <- encodeUtf8 <$> o .: "endpoint"
-    auth <- strDecode . encodeUtf8 <$?> o .: "auth"
-    p256dh <- strDecode . encodeUtf8 <$?> o .: "p256dh"
-    pure WPEndpoint {endpoint, auth, p256dh}
+    wpKey <- strP
+    pure WPTokenParams {wpPath, wpKey}
 
 data DeviceToken
-  = APNSDeviceToken APNSProvider ByteString
-  | WPDeviceToken WPProvider WPEndpoint
-  -- TODO [webpush] replace with WPTokenParams
-  -- | WPDeviceToken WPProvider WPTokenParams
+  = APNSDeviceToken APNSProvider B.ByteString
+  | WPDeviceToken WPProvider WPTokenParams
   deriving (Eq, Ord, Show)
 
 instance Encoding DeviceToken where
@@ -513,50 +651,67 @@ instance Encoding DeviceToken where
 instance StrEncoding DeviceToken where
   strEncode token = case token of
     APNSDeviceToken p t -> strEncode p <> " " <> t
-    WPDeviceToken p t -> strEncode (p, t)
+    -- We don't do strEncode (p, t), because we don't want any space between
+    -- p (e.g. webpush https://localhost) and t.wpPath (e.g /random)
+    WPDeviceToken p t -> strEncode p <> strEncode t
   strP = nullToken <|> deviceToken
     where
       nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token"
       deviceToken =
-        strP_ >>= \case
+        strP >>= \case
           PPAPNS p -> APNSDeviceToken p <$> hexStringP
-          PPWP p -> WPDeviceToken p <$> strP
-      hexStringP =
+          PPWP p -> do
+            t <- WPDeviceToken p <$> strP
+            _ <- wpRequest t
+            pure t
+      hexStringP = do
+        _ <- A.space
         A.takeWhile (`B.elem` "0123456789abcdef") >>= \s ->
           if even (B.length s) then pure s else fail "odd number of hex characters"
 
--- TODO [webpush] is it needed?
 instance ToJSON DeviceToken where
   toEncoding token = case token of
     APNSDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= decodeLatin1 t
-    WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t
+    -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt
+    WPDeviceToken p _ -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p)
+    -- WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t
   toJSON token = case token of
     APNSDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= decodeLatin1 t]
-    WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t]
+    -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt
+    WPDeviceToken p _ -> J.object ["pushProvider" .= decodeLatin1 (strEncode p)]
+    -- WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t]
 
 instance FromJSON DeviceToken where
   parseJSON = J.withObject "DeviceToken" $ \o ->
     (strDecode . encodeUtf8 <$?> o .: "pushProvider") >>= \case
       PPAPNS p -> APNSDeviceToken p . encodeUtf8 <$> (o .: "token")
-      PPWP p -> WPDeviceToken p <$> (o .: "token")
+      PPWP _ -> fail "FromJSON not implemented for WPDeviceToken"
 
 -- | Returns fields for the device token (pushProvider, token)
 -- TODO [webpush] save token as separate fields
-deviceTokenFields :: DeviceToken -> (PushProvider, ByteString)
+deviceTokenFields :: DeviceToken -> (PushProvider, B.ByteString)
 deviceTokenFields dt = case dt of
   APNSDeviceToken p t -> (PPAPNS p, t)
   WPDeviceToken p t -> (PPWP p, strEncode t)
 
 -- | Returns the device token from the fields (pushProvider, token)
-deviceToken' :: PushProvider -> ByteString -> DeviceToken
+deviceToken' :: PushProvider -> B.ByteString -> DeviceToken
 deviceToken' pp t = case pp of
   PPAPNS p -> APNSDeviceToken p t
   PPWP p -> WPDeviceToken p <$> either error id $ strDecode t
 
+wpRequest :: MonadFail m => DeviceToken -> m Request
+wpRequest (APNSDeviceToken _ _) = fail "Invalid device token"
+wpRequest (WPDeviceToken (WPP s) param) = do
+  let endpoint = strEncode s <> wpPath param
+  case parseUrlThrow $ B.unpack endpoint of
+    Left _ -> fail "Invalid URL"
+    Right r -> pure r
+
 -- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
 -- because strEncode of NonEmpty list uses comma for separator,
 -- and encoding of PNMessageData's smpQueue has comma in list of hosts
-encodePNMessages :: NonEmpty PNMessageData -> ByteString
+encodePNMessages :: NonEmpty PNMessageData -> B.ByteString
 encodePNMessages = B.intercalate ";" . map strEncode . L.toList
 
 pnMessagesP :: A.Parser (NonEmpty PNMessageData)
@@ -601,7 +756,7 @@ data NtfSubStatus
   | -- | SMP SERVICE error - rejected service signature on individual subscriptions
     NSService
   | -- | SMP error other than AUTH
-    NSErr ByteString
+    NSErr B.ByteString
   deriving (Eq, Ord, Show)
 
 ntfShouldSubscribe :: NtfSubStatus -> Bool
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index a4b2fca6e5..ec7ae51664 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -47,7 +47,7 @@ import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
 import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient)
-import Network.HTTP.Client (newManager)
+import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 
 data NtfServerConfig = NtfServerConfig
@@ -165,25 +165,35 @@ newNtfPushServer qSize apnsConfig = do
 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 newPushClient s pp = do
   case pp of
-    PPWebPush -> newWPPushClient s
-    _ -> newAPNSPushClient s pp
+    PPWP p -> newWPPushClient s p
+    PPAPNS p -> newAPNSPushClient s p
 
-newAPNSPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
+newAPNSPushClient :: NtfPushServer -> APNSProvider -> IO PushProviderClient
 newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do
   c <- case apnsProviderHost pp of
     Nothing -> pure $ \_ _ -> pure ()
     Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig
-  atomically $ TM.insert pp c pushClients
+  atomically $ TM.insert (PPAPNS pp) c pushClients
   pure c
 
-newWPPushClient :: NtfPushServer -> IO PushProviderClient
-newWPPushClient NtfPushServer {pushClients} = do
+newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient
+newWPPushClient NtfPushServer {pushClients} pp = do
   logDebug "New WP Client requested"
-  manager <- newManager tlsManagerSettings
+  -- We use one http manager per push server (which may be used by different clients)
+  manager <- wpHTTPManager
   let c = wpPushProviderClient manager
-  atomically $ TM.insert PPWebPush c pushClients
+  atomically $ TM.insert (PPWP pp) c pushClients
   pure c
 
+wpHTTPManager :: IO Manager
+wpHTTPManager = newManager tlsManagerSettings {
+    -- Ideally, we should be able to override the domain resolution to
+    -- disable requests to non-public IPs. The risk is very limited as
+    -- we allow https only, and the body is encrypted. Disabling redirections
+    -- avoids cross-protocol redir (https => http/unix)
+    managerModifyRequest = \r -> pure r { redirectCount = 0 }
+  }
+
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 getPushClient s@NtfPushServer {pushClients} pp =
   TM.lookupIO pp pushClients >>= maybe (newPushClient s pp) pure
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index ebe2238307..24652c81e7 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -257,8 +257,8 @@ $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
 
 -- TODO [webpush] change type accept token components so it only allows APNS token
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
-apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token} pn = do
-  tknStr <- deviceToken token
+apnsPushProviderClient _ NtfTknRec {token = WPDeviceToken _ _} _ = throwE PPInvalidPusher
+apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = APNSDeviceToken _ tknStr} pn = do
   http2 <- liftHTTPS2 $ getApnsHTTP2Client c
   nonce <- atomically $ C.randomCbNonce nonceDrg
   apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
@@ -272,9 +272,6 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token
     else logWarn $ "APNS error: " <> T.pack (show status) <> " " <> reason' <> apnsIds response
   result status reason'
   where
-    deviceToken t = case t of
-      APNSDeviceToken _ dt -> pure dt
-      _ -> throwE PPInvalidPusher
     apnsIds response = headerStr "apns-id" <> headerStr "apns-unique-id"
       where
         headerStr name =
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index be681b0348..58eb3fa58b 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -1,10 +1,7 @@
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# HLINT ignore "Use newtype instead of data" #-}
@@ -13,7 +10,7 @@ module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
 import Network.HTTP.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken), WPEndpoint (..), encodePNMessages, PNMessageData)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken, APNSDeviceToken), encodePNMessages, PNMessageData, WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, authToByteString, wpRequest)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -26,7 +23,6 @@ import qualified Network.HTTP.Types as N
 import qualified Data.Aeson as J
 import Data.Aeson ((.=))
 import qualified Data.Binary as Bin
-import qualified Data.Bits as Bits
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString.Lazy as BL
 import Data.List.NonEmpty (NonEmpty)
@@ -36,20 +32,18 @@ import Control.Monad.Trans.Except (throwE)
 import Crypto.Hash.Algorithms (SHA256)
 import Crypto.Random (MonadRandom(getRandomBytes))
 import qualified Crypto.Cipher.Types as CT
-import qualified Crypto.Error as CE
 import qualified Crypto.MAC.HMAC as HMAC
 import qualified Crypto.PubKey.ECC.DH as ECDH
 import qualified Crypto.PubKey.ECC.Types as ECC
-import GHC.Base (when)
 
 wpPushProviderClient :: Manager -> PushProviderClient
-wpPushProviderClient mg tkn pn = do
-  -- TODO [webpush] parsing will happen in DeviceToken parser, so it won't fail here
+wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
+wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = do
   -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
-  wpe@WPEndpoint {endpoint} <- tokenEndpoint tkn
-  r <- liftPPWPError $ parseUrlThrow $ B.unpack endpoint
+  -- parsing will happen in DeviceToken parser, so it won't fail here
+  r <- wpRequest token
   logDebug $ "Request to " <> tshow (host r)
-  encBody <- body wpe
+  encBody <- body
   let requestHeaders =
         [ ("TTL", "2592000"), -- 30 days
           ("Urgency", "high"),
@@ -66,27 +60,26 @@ wpPushProviderClient mg tkn pn = do
   _ <- liftPPWPError $ httpNoBody req mg
   pure ()
   where
-    tokenEndpoint :: NtfTknRec -> ExceptT PushProviderError IO WPEndpoint
-    tokenEndpoint NtfTknRec {token} = do
-      case token of
-        WPDeviceToken _p e -> pure e
-        _ -> fail "Wrong device token"
-    -- TODO: move to PPIndalidPusher ? WPEndpoint should be invalidated and removed if the key is invalid, but the validation key is never sent
-    body :: WPEndpoint -> ExceptT PushProviderError IO B.ByteString
-    body WPEndpoint {auth, p256dh} = withExceptT PPCryptoError $ wpEncrypt auth p256dh (BL.toStrict $ encodePN pn)
+    body :: ExceptT PushProviderError IO B.ByteString
+    body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodePN pn)
 
--- | encrypt :: auth -> key -> clear -> cipher
+-- | encrypt :: UA key -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
-wpEncrypt :: B.ByteString -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
-wpEncrypt auth uaPubKS clearT = do
+wpEncrypt :: WPKey -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
+wpEncrypt wpKey clearT = do
   salt :: B.ByteString <- liftIO $ getRandomBytes 16
   asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1
-  -- TODO [webpush] key parsing will happen in DeviceToken parser, so it won't fail here
-  uaPubK <- point uaPubKS
-  let asPubK = BL.toStrict . uncompressEncode . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
+  wpEncrypt' wpKey asPrivK salt clearT
+
+-- | encrypt :: UA key -> AS key -> salt -> clear -> cipher
+-- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
+wpEncrypt' :: WPKey -> ECC.PrivateNumber -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
+wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do
+  let uaPubKS = BL.toStrict . uncompressEncodePoint $ uaPubK
+  let asPubKS = BL.toStrict . uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
       ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK
       prkKey = hmac auth ecdhSecret
-      keyInfo = "WebPush: info\0" <> uaPubKS <> asPubK
+      keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS
       ikm = hmac prkKey (keyInfo <> "\x01")
       prk = hmac salt ikm
       cekInfo = "Content-Encoding: aes128gcm\0" :: B.ByteString
@@ -95,14 +88,18 @@ wpEncrypt auth uaPubKS clearT = do
       nonce = takeHM 12 $ hmac prk (nonceInfo <> "\x01")
       rs = BL.toStrict $ Bin.encode (4096 :: Bin.Word32) -- with RFC8291, it's ok to always use 4096 because there is only one single record and the final record can be smaller than rs (RFC8188)
       idlen = BL.toStrict $ Bin.encode (65 :: Bin.Word8) -- with RFC8291, keyid is the pubkey, so always 65 bytes
-      header = salt <> rs <> idlen <> asPubK
+      header = salt <> rs <> idlen <> asPubKS
   iv <- ivFrom nonce
   -- The last record uses a padding delimiter octet set to the value 0x02
   (C.AuthTag (CT.AuthTag tag), cipherT) <- C.encryptAES128NoPad (C.Key cek) iv $ clearT <> "\x02"
+  -- Uncomment to see intermediate values, to compare with RFC8291 example
+  -- liftIO . print $ strEncode (BA.convert ecdhSecret :: B.ByteString)
+  -- liftIO . print . strEncode $ takeHM 32 prkKey
+  -- liftIO . print $ strEncode cek
+  -- liftIO . print $ strEncode cipherT
   pure $ header <> cipherT <> BA.convert tag
   where
-    point :: B.ByteString -> ExceptT C.CryptoError IO ECC.Point
-    point s = withExceptT C.CryptoInvalidECCKey $ uncompressDecode $ BL.fromStrict s
+    auth = authToByteString wpAuth
     hmac k v = HMAC.hmac k v :: HMAC.HMAC SHA256
     takeHM :: Int -> HMAC.HMAC SHA256 -> B.ByteString
     takeHM n v = BL.toStrict $ BL.pack $ take n $ BA.unpack v
@@ -111,46 +108,6 @@ wpEncrypt auth uaPubKS clearT = do
       Left e -> throwE e
       Right iv -> pure iv
 
--- | Elliptic-Curve-Point-to-Octet-String Conversion without compression
--- | as required by RFC8291
--- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3
--- TODO [webpush] add them to the encoding of WPKey
-uncompressEncode :: ECC.Point -> BL.ByteString
-uncompressEncode (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y
-uncompressEncode ECC.PointO = "\0"
-
--- TODO [webpush] should be -> Either ... (which it would be in StrEncoding)
-uncompressDecode :: BL.ByteString -> ExceptT CE.CryptoError IO ECC.Point
-uncompressDecode "\0" = pure ECC.PointO
-uncompressDecode s = do
-  when (BL.take 1 s /= prefix) $ throwError CE.CryptoError_PointFormatUnsupported
-  when (BL.length s /= 65) $ throwError CE.CryptoError_KeySizeInvalid
-  let s' = BL.drop 1 s
-  x <- decodeBigInt $ BL.take 32 s'
-  y <- decodeBigInt $ BL.drop 32 s'
-  pure $ ECC.Point x y
-  where
-    prefix = "\x04" :: BL.ByteString
-
-encodeBigInt :: Integer -> BL.ByteString
-encodeBigInt i = do
-  let s1 = Bits.shiftR i 64
-      s2 = Bits.shiftR s1 64
-      s3 = Bits.shiftR s2 64
-  Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
-  where
-    w64 :: Integer -> Bin.Word64
-    w64 = fromIntegral
-
--- TODO [webpush] should be -> Either ... (which it would be in StrEncoding)
-decodeBigInt :: BL.ByteString -> ExceptT CE.CryptoError IO Integer
-decodeBigInt s = do
-  when (BL.length s /= 32) $ throwError CE.CryptoError_PointSizeInvalid
-  let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 )
-  pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0
-  where
-    shift i w = Bits.shiftL (fromIntegral w) (64 * i)
-
 -- TODO [webpush] use ToJSON
 encodePN :: PushNotification -> BL.ByteString
 encodePN pn = J.encode $ case pn of
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index e5822f9899..13ac3f1820 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -1147,7 +1147,7 @@ sameSrvAddr :: ProtocolServer p -> ProtocolServer p -> Bool
 sameSrvAddr ProtocolServer {host, port} ProtocolServer {host = h', port = p'} = host == h' && port == p'
 {-# INLINE sameSrvAddr #-}
 
-data ProtocolType = PSMP | PNTF | PXFTP | PHTTPS
+data ProtocolType = PSMP | PNTF | PXFTP
   deriving (Eq, Ord, Show)
 
 instance StrEncoding ProtocolType where
@@ -1155,20 +1155,17 @@ instance StrEncoding ProtocolType where
     PSMP -> "smp"
     PNTF -> "ntf"
     PXFTP -> "xftp"
-    PHTTPS -> "https"
   strP =
     A.takeTill (\c -> c == ':' || c == ' ') >>= \case
       "smp" -> pure PSMP
       "ntf" -> pure PNTF
       "xftp" -> pure PXFTP
-      "https" -> pure PHTTPS
       _ -> fail "bad ProtocolType"
 
 data SProtocolType (p :: ProtocolType) where
   SPSMP :: SProtocolType 'PSMP
   SPNTF :: SProtocolType 'PNTF
   SPXFTP :: SProtocolType 'PXFTP
-  SPHTTPS :: SProtocolType 'PHTTPS
 
 deriving instance Eq (SProtocolType p)
 
@@ -1187,7 +1184,6 @@ instance TestEquality SProtocolType where
   testEquality SPSMP SPSMP = Just Refl
   testEquality SPNTF SPNTF = Just Refl
   testEquality SPXFTP SPXFTP = Just Refl
-  testEquality SPHTTPS SPHTTPS = Just Refl
   testEquality _ _ = Nothing
 
 protocolType :: SProtocolType p -> ProtocolType
@@ -1195,14 +1191,12 @@ protocolType = \case
   SPSMP -> PSMP
   SPNTF -> PNTF
   SPXFTP -> PXFTP
-  SPHTTPS -> PHTTPS
 
 aProtocolType :: ProtocolType -> AProtocolType
 aProtocolType = \case
   PSMP -> AProtocolType SPSMP
   PNTF -> AProtocolType SPNTF
   PXFTP -> AProtocolType SPXFTP
-  PHTTPS -> AProtocolType SPHTTPS
 
 instance ProtocolTypeI p => StrEncoding (SProtocolType p) where
   strEncode = strEncode . protocolType
@@ -1240,8 +1234,6 @@ instance ProtocolTypeI 'PNTF where protocolTypeI = SPNTF
 
 instance ProtocolTypeI 'PXFTP where protocolTypeI = SPXFTP
 
-instance ProtocolTypeI 'PHTTPS where protocolTypeI = SPHTTPS
-
 type family UserProtocol (p :: ProtocolType) :: Constraint where
   UserProtocol PSMP = ()
   UserProtocol PXFTP = ()
diff --git a/src/Simplex/Messaging/ServiceScheme.hs b/src/Simplex/Messaging/ServiceScheme.hs
index 3cd828aa75..1f9fe22e19 100644
--- a/src/Simplex/Messaging/ServiceScheme.hs
+++ b/src/Simplex/Messaging/ServiceScheme.hs
@@ -9,6 +9,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Network.Socket (HostName, ServiceName)
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Encoding (Encoding(..))
 
 data ServiceScheme = SSSimplex | SSAppServer SrvLoc
   deriving (Eq, Show)
@@ -24,6 +25,12 @@ instance StrEncoding ServiceScheme where
 data SrvLoc = SrvLoc HostName ServiceName
   deriving (Eq, Ord, Show)
 
+instance Encoding SrvLoc where
+  smpEncode (SrvLoc h s) = smpEncode (h, s)
+  smpP = do
+    (h, s) <- smpP
+    pure $ SrvLoc h s
+
 instance StrEncoding SrvLoc where
   strEncode (SrvLoc host port) = B.pack $ host <> if null port then "" else ':' : port
   strP = SrvLoc <$> host <*> (port <|> pure "")
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 43375c6e3c..0912e29b27 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -355,7 +355,7 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
           SET tkn_status = ?, tkn_action = ?
           WHERE provider = ? AND device_token = ?
         |]
-        (NTConfirmed, Just (NTAVerify code), PPApnsTest, "abcd" :: ByteString)
+        (NTConfirmed, Just (NTAVerify code), PPAPNS PPApnsTest, "abcd" :: ByteString)
     Just NtfToken {ntfTknStatus = NTConfirmed, ntfTknAction = Just (NTAVerify _)} <- withTransaction store getSavedNtfToken
     pure ()
   threadDelay 1500000
@@ -409,7 +409,7 @@ testNtfTokenServerRestartReregisterTimeout t apns = do
           SET tkn_id = NULL, tkn_dh_secret = NULL, tkn_status = ?, tkn_action = ?
           WHERE provider = ? AND device_token = ?
         |]
-        (NTNew, Just NTARegister, PPApnsTest, "abcd" :: ByteString)
+        (NTNew, Just NTARegister, PPAPNS PPApnsTest, "abcd" :: ByteString)
     Just NtfToken {ntfTokenId = Nothing, ntfTknStatus = NTNew, ntfTknAction = Just NTARegister} <- withTransaction store getSavedNtfToken
     pure ()
   threadDelay 1000000
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index bd833446c3..bdd57f61c1 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -60,6 +60,7 @@ import UnliftIO.Async
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
+import Control.Exception (throwIO)
 
 testHost :: NonEmpty TransportHost
 testHost = "localhost"
@@ -293,6 +294,7 @@ getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
           sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body"
 
 getMockNotification :: MonadIO m => APNSMockServer -> DeviceToken -> m APNSMockRequest
+getMockNotification _ (WPDeviceToken _ _) = liftIO . throwIO $ userError "Invalid pusher"
 getMockNotification APNSMockServer {notifications} (APNSDeviceToken _ token) = do
   atomically $ TM.lookup token notifications >>= maybe retry readTBQueue
 
diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
new file mode 100644
index 0000000000..6068e5d3ea
--- /dev/null
+++ b/tests/NtfWPTests.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+
+module NtfWPTests where
+
+import Test.Hspec hiding (fit, it)
+import Util
+import Simplex.Messaging.Encoding.String (StrEncoding(..))
+import qualified Data.ByteString as B
+import qualified Crypto.PubKey.ECC.Types as ECC
+import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodePN)
+import Control.Monad.Except (runExceptT)
+import qualified Data.ByteString.Lazy as BL
+import Simplex.Messaging.Notifications.Server.Push
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import qualified Simplex.Messaging.Crypto as C
+import Data.Time.Clock.System (SystemTime(..))
+import Data.Either (isLeft)
+
+ntfWPTests :: Spec
+ntfWPTests = describe "NTF Protocol" $ do
+  it "decode WPDeviceToken from string" testWPDeviceTokenStrEncoding
+  it "decode invalid WPDeviceToken" testInvalidWPDeviceTokenStrEncoding
+  it "Encrypt RFC8291 example" testWPEncryption
+  it "PushNotifications encoding" testPNEncoding
+
+testWPDeviceTokenStrEncoding :: Expectation
+testWPDeviceTokenStrEncoding = do
+  let ts = "webpush https://localhost/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  -- let ts = "apns_null test_ntf_token"
+  -- let ts = "apns_test 11111111222222223333333344444444"
+
+  let auth = either error id $ strDecode "AQ3VfRX3_F38J3ltcmMVRg"
+  let pk = either error id $ strDecode "BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  let params ::WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  wpPath params `shouldBe` "/secret"
+  let key = wpKey params
+  wpAuth key `shouldBe` auth
+  wpP256dh key `shouldBe` pk
+
+  let pp@(WPP s) :: WPProvider = either error id $ strDecode "webpush https://localhost"
+
+  let parsed = either error id $ strDecode ts
+  parsed `shouldBe` WPDeviceToken pp params
+  -- TODO: strEncoding should be base64url _without padding_
+  -- strEncode parsed `shouldBe` ts
+
+  strEncode s <> wpPath params `shouldBe` "https://localhost/secret"
+
+testInvalidWPDeviceTokenStrEncoding :: Expectation
+testInvalidWPDeviceTokenStrEncoding = do
+  -- http-client parser parseUrlThrow is very very lax,
+  -- e.g "https://#1" is a valid URL. But that is the same parser
+  -- we use to send the requests, so that's fine.
+  let ts = "webpush https://localhost:/ AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  let t = strDecode ts :: Either String DeviceToken
+  t `shouldSatisfy` isLeft
+
+-- | Example from RFC8291
+testWPEncryption :: Expectation
+testWPEncryption = do
+  let clearT :: B.ByteString = "When I grow up, I want to be a watermelon"
+  let pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4"
+  let salt :: B.ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw"
+  let privBS :: BL.ByteString = either error BL.fromStrict $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw"
+  asPriv :: ECC.PrivateNumber <- case uncompressDecodePrivateNumber privBS of
+    Left e -> fail $ "Cannot decode PrivateNumber from b64 " <> show e
+    Right p -> pure p
+  mCip <- runExceptT $ wpEncrypt' (wpKey pParams) asPriv salt clearT
+  cipher <- case mCip of
+    Left _ -> fail "Cannot encrypt clear text"
+    Right c -> pure c
+  strEncode cipher `shouldBe` "DGv6ra1nlYgDCS1FRnbzlwAAEABBBP4z9KsN6nGRTbVYI_c7VJSPQTBtkgcy27mlmlMoZIIgDll6e3vCYLocInmYWAmS6TlzAC8wEqKK6PBru3jl7A_yl95bQpu6cVPTpK4Mqgkf1CXztLVBSt2Ks3oZwbuwXPXLWyouBWLVWGNWQexSgSxsj_Qulcy4a-fN"
+
+testPNEncoding :: Expectation
+testPNEncoding = do
+  let pnVerif = PNVerification (NtfRegCode "abcd")
+      pnCheck = PNCheckMessages
+      pnMess = pnM "MyMessage"
+  enc pnCheck `shouldBe` "{\"checkMessages\":true}"
+  enc pnVerif `shouldBe` "{\"verification\":\"YWJjZA==\"}"
+  enc pnMess `shouldBe` "{\"message\":\"smp://AAAA@l/AAAA 1761827386 bm9uY2UAAAAAAAAAAAAAAAAAAAAAAAAA TXlNZXNzYWdl\"}"
+  where
+    enc p = BL.toStrict $ encodePN p
+    pnM :: B.ByteString -> PushNotification
+    pnM m = do
+      let smpQ = either error id $ strDecode "smp://AAAA@l/AAAA"
+      let now = MkSystemTime 1761827386 0
+      PNMessage $ PNMessageData smpQ now (C.cbNonce "nonce") m :| []
diff --git a/tests/Test.hs b/tests/Test.hs
index 3e36e192d6..611a6e2413 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -45,6 +45,7 @@ import AgentTests.SchemaDump (schemaDumpTest)
 #if defined(dbServerPostgres)
 import NtfServerTests (ntfServerTests)
 import NtfClient (ntfTestServerDBConnectInfo, ntfTestStoreDBOpts)
+import NtfWPTests (ntfWPTests)
 import PostgresSchemaDump (postgresSchemaDumpTest)
 import SMPClient (testServerDBConnectInfo, testStoreDBOpts)
 import Simplex.Messaging.Notifications.Server.Store.Migrations (ntfServerMigrations)
@@ -139,6 +140,7 @@ main = do
           --   before (pure $ ASType SQSPostgres SMSJournal) smpProxyTests
           describe "SMP proxy, postgres-only message store" $
             before (pure $ ASType SQSPostgres SMSPostgres) smpProxyTests
+        describe "NTF WP tests" ntfWPTests
 #endif
         -- xdescribe "SMP client agent, server jornal message store" $ agentTests (transport @TLS, ASType SQSMemory SMSJournal)
         describe "SMP client agent, server memory message store" $ agentTests (transport @TLS, ASType SQSMemory SMSMemory)

From 8ee3fd0ef75098664739358a5ed9cc966e8d7e0a Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 10 Nov 2025 21:14:09 +0000
Subject: [PATCH 12/26] fix migration

---
 .../Notifications/Server/Store/Migrations.hs     | 16 +++++++---------
 1 file changed, 7 insertions(+), 9 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Store/Migrations.hs b/src/Simplex/Messaging/Notifications/Server/Store/Migrations.hs
index 8f63d1b650..b07efa101b 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/Migrations.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store/Migrations.hs
@@ -79,7 +79,7 @@ CREATE INDEX idx_last_notifications_token_id_sent_at ON last_notifications(token
 CREATE INDEX idx_last_notifications_subscription_id ON last_notifications(subscription_id);
 
 CREATE UNIQUE INDEX idx_last_notifications_token_subscription ON last_notifications(token_id, subscription_id);
-    |]
+  |]
 
 m20250517_service_cert :: Text
 m20250517_service_cert =
@@ -90,7 +90,7 @@ ALTER TABLE subscriptions ADD COLUMN ntf_service_assoc BOOLEAN NOT NULL DEFAULT
 
 DROP INDEX idx_subscriptions_smp_server_id_status;
 CREATE INDEX idx_subscriptions_smp_server_id_ntf_service_status ON subscriptions(smp_server_id, ntf_service_assoc, status);
-    |]
+  |]
 
 down_m20250517_service_cert :: Text
 down_m20250517_service_cert =
@@ -101,12 +101,11 @@ CREATE INDEX idx_subscriptions_smp_server_id_status ON subscriptions(smp_server_
 ALTER TABLE smp_servers DROP COLUMN ntf_service_id;
 
 ALTER TABLE subscriptions DROP COLUMN ntf_service_assoc;
-    |]
+  |]
 
 m20250916_webpush :: Text
 m20250916_webpush =
-  T.pack
-    [r|
+  [r|
 CREATE TABLE webpush_servers(
   wp_server_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
   wp_host TEXT NOT NULL,
@@ -119,12 +118,11 @@ ALTER TABLE tokens
   ADD COLUMN wp_path TEXT,
   ADD COLUMN wp_auth BYTEA,
   ADD COLUMN wp_key BYTEA;
-    |]
+  |]
 
 down_m20250916_webpush :: Text
 down_m20250916_webpush =
-  T.pack
-    [r|
+  [r|
 ALTER TABLE tokens
   DROP COLUMN wp_server_id,
   DROP COLUMN wp_path,
@@ -132,4 +130,4 @@ ALTER TABLE tokens
   DROP COLUMN wp_key;
 
 DROP TABLE webpush_servers;
-    |]
+  |]

From 7485175980588f0eb331e4be6c7112640ca4b12c Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Mon, 10 Nov 2025 21:30:06 +0000
Subject: [PATCH 13/26] remove comment

---
 src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 58eb3fa58b..9a02ce1e0b 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -108,7 +108,6 @@ wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do
       Left e -> throwE e
       Right iv -> pure iv
 
--- TODO [webpush] use ToJSON
 encodePN :: PushNotification -> BL.ByteString
 encodePN pn = J.encode $ case pn of
   PNVerification code -> J.object ["verification" .= code]

From 63c4647f3904437f3522d20ee0cb0fc44d205f12 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 11 Nov 2025 16:54:38 +0000
Subject: [PATCH 14/26] refactor

---
 .../Messaging/Notifications/Protocol.hs       | 90 +++++--------------
 .../Notifications/Server/Push/WebPush.hs      | 22 ++---
 .../Server/Store/ntf_server_schema.sql        | 36 +++++++-
 3 files changed, 68 insertions(+), 80 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 93d18389b2..07488c336b 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -17,8 +17,8 @@ import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString as S
 import Data.Functor (($>))
 import Data.Kind
 import Data.List.NonEmpty (NonEmpty (..))
@@ -27,7 +27,7 @@ import Data.Maybe (isNothing)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock.System
 import Data.Type.Equality
-import Data.Word (Word8, Word16)
+import Data.Word (Word16)
 import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
 import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
@@ -113,7 +113,7 @@ instance ProtocolMsgTag NtfCmdTag where
 instance NtfEntityI e => ProtocolMsgTag (NtfCommandTag e) where
   decodeTag s = decodeTag s >>= (\(NCT _ t) -> checkEntity' t)
 
-newtype NtfRegCode = NtfRegCode B.ByteString
+newtype NtfRegCode = NtfRegCode ByteString
   deriving (Eq, Show)
 
 instance Encoding NtfRegCode where
@@ -212,7 +212,7 @@ instance NtfEntityI e => ProtocolEncoding NTFVersion ErrorType (NtfCommand e) wh
     SDEL -> e SDEL_
     PING -> e PING_
     where
-      e :: Encoding a => a -> B.ByteString
+      e :: Encoding a => a -> ByteString
       e = smpEncode
 
   protocolP _v tag = (\(NtfCmd _ c) -> checkEntity c) <$?> protocolP _v (NCT (sNtfEntity @e) tag)
@@ -321,7 +321,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
     NRSub stat -> e (NRSub_, ' ', stat)
     NRPong -> e NRPong_
     where
-      e :: Encoding a => a -> B.ByteString
+      e :: Encoding a => a -> ByteString
       e = smpEncode
 
   protocolP _v = \case
@@ -460,48 +460,12 @@ instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe
 
 instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode
 
-tupleToList16
-  :: (a,a,a,a,
-      a,a,a,a,
-      a,a,a,a,
-      a,a,a,a)
-  -> [a]
-tupleToList16
-  (a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15) =
-    [a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15]
-
-listToTuple16
-  :: [a]
-  -> Maybe (a,a,a,a,
-            a,a,a,a,
-            a,a,a,a,
-            a,a,a,a)
-listToTuple16
-  [a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15] =
-    Just (a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15)
-listToTuple16 _ = Nothing
-
-newtype Auth = Auth (Word8, Word8, Word8, Word8,
-                     Word8, Word8, Word8, Word8,
-                     Word8, Word8, Word8, Word8,
-                     Word8, Word8, Word8, Word8)
-
-instance Eq Auth where
-  (Auth t1) == (Auth t2) = tupleToList16 t1 == tupleToList16 t2
-
-instance Ord Auth where
-  compare (Auth t1) (Auth t2) = compare (tupleToList16 t1) (tupleToList16 t2)
-
-instance Show Auth where
-  show (Auth t) = "Auth " ++ show (tupleToList16 t)
-
-authFromByteString :: S.ByteString -> Maybe Auth
-authFromByteString bs = do
-  tup <- listToTuple16 $ S.unpack bs
-  pure (Auth tup)
-
-authToByteString :: Auth -> S.ByteString
-authToByteString (Auth a) = S.pack $ tupleToList16 a
+newtype WPAuth = WPAuth {unWPAuth :: ByteString} deriving (Eq, Ord, Show)
+
+toWPAuth :: ByteString -> Either String WPAuth
+toWPAuth s
+  | B.length s == 16 = Right $ WPAuth s
+  | otherwise = Left "bad WPAuth"
 
 newtype WPP256dh = WPP256dh ECC.PublicPoint
   deriving (Eq, Show)
@@ -515,7 +479,7 @@ instance Ord WPP256dh where
       comparePt (ECC.Point x1 y1)  (ECC.Point x2 y2) = compare (x1, y1) (x2, y2)
 
 data WPKey = WPKey
-  { wpAuth :: Auth,
+  { wpAuth :: WPAuth,
     wpP256dh :: WPP256dh
   }
   deriving (Eq, Ord, Show)
@@ -573,24 +537,18 @@ decodeBigInt s
     shift i w = Bits.shiftL (fromIntegral w) (64 * i)
 
 data WPTokenParams = WPTokenParams
-  { wpPath :: B.ByteString,
+  { wpPath :: ByteString,
     wpKey :: WPKey
   }
   deriving (Eq, Ord, Show)
 
-instance Encoding Auth where
-  smpEncode a = smpEncode $ authToByteString a
-  smpP = smpP >>= \bs ->
-    case authFromByteString bs of
-      Nothing -> fail "Invalid auth"
-      Just a -> pure a
+instance Encoding WPAuth where
+  smpEncode = smpEncode . unWPAuth
+  smpP = toWPAuth <$?> smpP
 
-instance StrEncoding Auth where
-  strEncode a = strEncode $ authToByteString a
-  strP = strP >>= \bs ->
-    case authFromByteString bs of
-      Nothing -> fail "Invalid auth"
-      Just a -> pure a
+instance StrEncoding WPAuth where
+  strEncode = strEncode . unWPAuth
+  strP = toWPAuth <$?> strP
 
 instance Encoding WPP256dh where
   smpEncode p = smpEncode . BL.toStrict $ uncompressEncode p
@@ -635,7 +593,7 @@ instance StrEncoding WPTokenParams where
     pure WPTokenParams {wpPath, wpKey}
 
 data DeviceToken
-  = APNSDeviceToken APNSProvider B.ByteString
+  = APNSDeviceToken APNSProvider ByteString
   | WPDeviceToken WPProvider WPTokenParams
   deriving (Eq, Ord, Show)
 
@@ -689,13 +647,13 @@ instance FromJSON DeviceToken where
 
 -- | Returns fields for the device token (pushProvider, token)
 -- TODO [webpush] save token as separate fields
-deviceTokenFields :: DeviceToken -> (PushProvider, B.ByteString)
+deviceTokenFields :: DeviceToken -> (PushProvider, ByteString)
 deviceTokenFields dt = case dt of
   APNSDeviceToken p t -> (PPAPNS p, t)
   WPDeviceToken p t -> (PPWP p, strEncode t)
 
 -- | Returns the device token from the fields (pushProvider, token)
-deviceToken' :: PushProvider -> B.ByteString -> DeviceToken
+deviceToken' :: PushProvider -> ByteString -> DeviceToken
 deviceToken' pp t = case pp of
   PPAPNS p -> APNSDeviceToken p t
   PPWP p -> WPDeviceToken p <$> either error id $ strDecode t
@@ -711,7 +669,7 @@ wpRequest (WPDeviceToken (WPP s) param) = do
 -- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
 -- because strEncode of NonEmpty list uses comma for separator,
 -- and encoding of PNMessageData's smpQueue has comma in list of hosts
-encodePNMessages :: NonEmpty PNMessageData -> B.ByteString
+encodePNMessages :: NonEmpty PNMessageData -> ByteString
 encodePNMessages = B.intercalate ";" . map strEncode . L.toList
 
 pnMessagesP :: A.Parser (NonEmpty PNMessageData)
@@ -756,7 +714,7 @@ data NtfSubStatus
   | -- | SMP SERVICE error - rejected service signature on individual subscriptions
     NSService
   | -- | SMP error other than AUTH
-    NSErr B.ByteString
+    NSErr ByteString
   deriving (Eq, Ord, Show)
 
 ntfShouldSubscribe :: NtfSubStatus -> Bool
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 9a02ce1e0b..9b1ebb9f8d 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -10,7 +10,7 @@ module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
 import Network.HTTP.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken, APNSDeviceToken), encodePNMessages, PNMessageData, WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, authToByteString, wpRequest)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -25,9 +25,6 @@ import Data.Aeson ((.=))
 import qualified Data.Binary as Bin
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString.Lazy as BL
-import Data.List.NonEmpty (NonEmpty)
-import qualified Data.Text.Encoding as T
-import qualified Data.Text as T
 import Control.Monad.Trans.Except (throwE)
 import Crypto.Hash.Algorithms (SHA256)
 import Crypto.Random (MonadRandom(getRandomBytes))
@@ -61,7 +58,7 @@ wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = d
   pure ()
   where
     body :: ExceptT PushProviderError IO B.ByteString
-    body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodePN pn)
+    body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn)
 
 -- | encrypt :: UA key -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
@@ -78,7 +75,7 @@ wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do
   let uaPubKS = BL.toStrict . uncompressEncodePoint $ uaPubK
   let asPubKS = BL.toStrict . uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
       ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK
-      prkKey = hmac auth ecdhSecret
+      prkKey = hmac (unWPAuth wpAuth) ecdhSecret
       keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS
       ikm = hmac prkKey (keyInfo <> "\x01")
       prk = hmac salt ikm
@@ -99,7 +96,6 @@ wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do
   -- liftIO . print $ strEncode cipherT
   pure $ header <> cipherT <> BA.convert tag
   where
-    auth = authToByteString wpAuth
     hmac k v = HMAC.hmac k v :: HMAC.HMAC SHA256
     takeHM :: Int -> HMAC.HMAC SHA256 -> B.ByteString
     takeHM n v = BL.toStrict $ BL.pack $ take n $ BA.unpack v
@@ -108,14 +104,14 @@ wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do
       Left e -> throwE e
       Right iv -> pure iv
 
-encodePN :: PushNotification -> BL.ByteString
-encodePN pn = J.encode $ case pn of
+encodeWPN :: PushNotification -> BL.ByteString
+encodeWPN pn = J.encode $ case pn of
   PNVerification code -> J.object ["verification" .= code]
-  PNMessage d -> J.object ["message" .= encodeData d]
+  -- This hack prevents sending unencrypted message metadata in notifications, as we do not use it in the client - it simply receives all messages on each notification.
+  -- If we decide to change it to pull model as used in iOS, we can change JSON key to "message" with any payload, as the current clients would interpret it as "checkMessages".
+  -- In this case an additional encryption layer would need to be added here, in the same way as with APNS notifications.
+  PNMessage _ -> J.object ["checkMessages" .= True]
   PNCheckMessages -> J.object ["checkMessages" .= True]
-  where
-    encodeData :: NonEmpty PNMessageData -> String
-    encodeData a = T.unpack . T.decodeUtf8 $ encodePNMessages a
 
 liftPPWPError :: IO a -> ExceptT PushProviderError IO a
 liftPPWPError = liftPPWPError' toPPWPError
diff --git a/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql b/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
index 3b155fa1a9..535652b682 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
+++ b/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
@@ -92,7 +92,31 @@ CREATE TABLE ntf_server.tokens (
     reg_code bytea NOT NULL,
     cron_interval bigint NOT NULL,
     cron_sent_at bigint,
-    updated_at bigint
+    updated_at bigint,
+    wp_server_id bigint,
+    wp_path text,
+    wp_auth bytea,
+    wp_key bytea
+);
+
+
+
+CREATE TABLE ntf_server.webpush_servers (
+    wp_server_id bigint NOT NULL,
+    wp_host text NOT NULL,
+    wp_port text NOT NULL,
+    wp_keyhash bytea NOT NULL
+);
+
+
+
+ALTER TABLE ntf_server.webpush_servers ALTER COLUMN wp_server_id ADD GENERATED ALWAYS AS IDENTITY (
+    SEQUENCE NAME ntf_server.webpush_servers_wp_server_id_seq
+    START WITH 1
+    INCREMENT BY 1
+    NO MINVALUE
+    NO MAXVALUE
+    CACHE 1
 );
 
 
@@ -122,6 +146,11 @@ ALTER TABLE ONLY ntf_server.tokens
 
 
 
+ALTER TABLE ONLY ntf_server.webpush_servers
+    ADD CONSTRAINT webpush_servers_pkey PRIMARY KEY (wp_server_id);
+
+
+
 CREATE INDEX idx_last_notifications_subscription_id ON ntf_server.last_notifications USING btree (subscription_id);
 
 
@@ -178,3 +207,8 @@ ALTER TABLE ONLY ntf_server.subscriptions
 
 
 
+ALTER TABLE ONLY ntf_server.tokens
+    ADD CONSTRAINT tokens_wp_server_id_fkey FOREIGN KEY (wp_server_id) REFERENCES ntf_server.webpush_servers(wp_server_id) ON UPDATE RESTRICT ON DELETE RESTRICT;
+
+
+

From 673f50e0f4856bf5166bb684d681c638e1f79dc7 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 11 Nov 2025 17:15:23 +0000
Subject: [PATCH 15/26] remove unused error constructor

---
 src/Simplex/Messaging/Crypto.hs | 2 --
 tests/NtfWPTests.hs             | 4 ++--
 2 files changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 2e45773c2a..c2bec78242 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -914,8 +914,6 @@ data CryptoError
     CERatchetEarlierMessage Word32
   | -- | duplicate message number
     CERatchetDuplicateMessage
-  | -- | unable to decode ecc key
-    CryptoInvalidECCKey CE.CryptoError -- TODO [webpush] remove this error, it will be parsing error
   deriving (Eq, Show, Exception)
 
 aesKeySize :: Int
diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 6068e5d3ea..482126661b 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -10,7 +10,7 @@ import Simplex.Messaging.Encoding.String (StrEncoding(..))
 import qualified Data.ByteString as B
 import qualified Crypto.PubKey.ECC.Types as ECC
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodePN)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN)
 import Control.Monad.Except (runExceptT)
 import qualified Data.ByteString.Lazy as BL
 import Simplex.Messaging.Notifications.Server.Push
@@ -83,7 +83,7 @@ testPNEncoding = do
   enc pnVerif `shouldBe` "{\"verification\":\"YWJjZA==\"}"
   enc pnMess `shouldBe` "{\"message\":\"smp://AAAA@l/AAAA 1761827386 bm9uY2UAAAAAAAAAAAAAAAAAAAAAAAAA TXlNZXNzYWdl\"}"
   where
-    enc p = BL.toStrict $ encodePN p
+    enc p = BL.toStrict $ encodeWPN p
     pnM :: B.ByteString -> PushNotification
     pnM m = do
       let smpQ = either error id $ strDecode "smp://AAAA@l/AAAA"

From a4931289a73ca67ef7ba8ad7d2313f25c364667d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 11 Nov 2025 17:39:12 +0000
Subject: [PATCH 16/26] remove function

---
 src/Simplex/Messaging/Crypto.hs | 14 ++++----------
 1 file changed, 4 insertions(+), 10 deletions(-)

diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index c2bec78242..1fa2c6d4c3 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -1048,12 +1048,12 @@ encryptAES128NoPad key iv = encryptAEAD128NoPad key iv ""
 
 encryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
 encryptAEADNoPad aesKey ivBytes ad msg = do
-  aead <- initAEADGCM aesKey ivBytes
+  aead <- initAEADGCM @AES256 aesKey ivBytes
   pure . first AuthTag $ AES.aeadSimpleEncrypt aead ad msg authTagSize
 
 encryptAEAD128NoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
 encryptAEAD128NoPad aesKey ivBytes ad msg = do
-  aead <- initAEAD128GCM aesKey ivBytes
+  aead <- initAEADGCM @AES128 aesKey ivBytes
   pure . first AuthTag $ AES.aeadSimpleEncrypt aead ad msg authTagSize
 
 -- | AEAD-GCM decryption with associated data.
@@ -1075,7 +1075,7 @@ decryptAESNoPad key iv = decryptAEADNoPad key iv ""
 
 decryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> AuthTag -> ExceptT CryptoError IO ByteString
 decryptAEADNoPad aesKey iv ad msg (AuthTag tag) = do
-  aead <- initAEADGCM aesKey iv
+  aead <- initAEADGCM @AES256 aesKey iv
   maybeError AESDecryptError (AES.aeadSimpleDecrypt aead ad msg tag)
 
 maxMsgLen :: Int
@@ -1150,17 +1150,11 @@ initAEAD (Key aesKey) (IV ivBytes) = do
     AES.aeadInit AES.AEAD_GCM cipher iv
 
 -- this function requires 12 bytes IV, it does not transforms IV.
-initAEADGCM :: Key -> GCMIV -> ExceptT CryptoError IO (AES.AEAD AES256)
+initAEADGCM :: forall c. AES.BlockCipher c => Key -> GCMIV -> ExceptT CryptoError IO (AES.AEAD c)
 initAEADGCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
   cipher <- AES.cipherInit aesKey
   AES.aeadInit AES.AEAD_GCM cipher ivBytes
 
--- this function requires 12 bytes IV, it does not transforms IV.
-initAEAD128GCM :: Key -> GCMIV -> ExceptT CryptoError IO (AES.AEAD AES128)
-initAEAD128GCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
-  cipher <- AES.cipherInit aesKey
-  AES.aeadInit AES.AEAD_GCM cipher ivBytes
-
 -- | Random AES256 key.
 randomAesKey :: TVar ChaChaDRG -> STM Key
 randomAesKey = fmap Key . randomBytes aesKeySize

From 4257255de2a8e88d3f6c825591420a65e1fcfe4d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 11 Nov 2025 17:51:50 +0000
Subject: [PATCH 17/26] fix test

---
 tests/NtfWPTests.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 482126661b..8a5fcf1803 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -81,7 +81,7 @@ testPNEncoding = do
       pnMess = pnM "MyMessage"
   enc pnCheck `shouldBe` "{\"checkMessages\":true}"
   enc pnVerif `shouldBe` "{\"verification\":\"YWJjZA==\"}"
-  enc pnMess `shouldBe` "{\"message\":\"smp://AAAA@l/AAAA 1761827386 bm9uY2UAAAAAAAAAAAAAAAAAAAAAAAAA TXlNZXNzYWdl\"}"
+  enc pnMess `shouldBe` "{\"checkMessages\":true}"
   where
     enc p = BL.toStrict $ encodeWPN p
     pnM :: B.ByteString -> PushNotification

From 17fe6edcde5bbfa8d1f3a0a3f4bf10655dbd78cc Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 11 Nov 2025 18:16:20 +0000
Subject: [PATCH 18/26] instance

---
 src/Simplex/Messaging/Notifications/Protocol.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 07488c336b..d62a3f2c43 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -470,13 +470,13 @@ toWPAuth s
 newtype WPP256dh = WPP256dh ECC.PublicPoint
   deriving (Eq, Show)
 
+-- This Ord instance for ECC point is quite arbitrary, it is needed because token is used as Map key
 instance Ord WPP256dh where
-  compare (WPP256dh p1) (WPP256dh p2) = comparePt p1 p2
-    where
-      comparePt ECC.PointO ECC.PointO = EQ
-      comparePt ECC.PointO (ECC.Point _ _) = LT
-      comparePt (ECC.Point _ _) ECC.PointO = GT
-      comparePt (ECC.Point x1 y1)  (ECC.Point x2 y2) = compare (x1, y1) (x2, y2)
+  compare (WPP256dh p1) (WPP256dh p2) = case (p1, p2) of
+    (ECC.PointO, ECC.PointO) -> EQ
+    (ECC.PointO, _) -> GT
+    (_, ECC.PointO) -> LT
+    (ECC.Point x1 y1, ECC.Point x2 y2) -> compare (x1, y1) (x2, y2)
 
 data WPKey = WPKey
   { wpAuth :: WPAuth,

From 1007deb1f50b24984381fd00c992bd03dfa28ff6 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 11 Nov 2025 18:41:20 +0000
Subject: [PATCH 19/26] refactor

---
 src/Simplex/Messaging/Notifications/Protocol.hs   |  5 +++++
 src/Simplex/Messaging/Notifications/Server.hs     | 14 +++++++-------
 src/Simplex/Messaging/Notifications/Server/Env.hs | 15 ++++++---------
 3 files changed, 18 insertions(+), 16 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index d62a3f2c43..42e6c09db7 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -597,6 +597,11 @@ data DeviceToken
   | WPDeviceToken WPProvider WPTokenParams
   deriving (Eq, Ord, Show)
 
+tokenPushProvider :: DeviceToken -> PushProvider
+tokenPushProvider = \case
+  APNSDeviceToken pp _ -> PPAPNS pp
+  WPDeviceToken pp _ -> PPWP pp
+
 instance Encoding DeviceToken where
   smpEncode token = case token of
     APNSDeviceToken p t -> smpEncode (p, t)
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index bf6f7345e7..46258c7f71 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -630,18 +630,17 @@ showServer' = decodeLatin1 . strEncode . host
 ntfPush :: NtfPushServer -> M ()
 ntfPush s@NtfPushServer {pushQ} = forever $ do
   (srvHost_, tkn@NtfTknRec {ntfTknId, token = t, tknStatus}, ntf) <- atomically (readTBQueue pushQ)
-  let (pp, _) = deviceTokenFields t
-  liftIO $ logDebug $ "sending push notification to " <> T.pack (show pp)
+  logDebug $ "sending push notification to " <> tshow (tokenPushProvider t)
   st <- asks store
   case ntf of
     PNVerification _ ->
-      liftIO (deliverNotification st pp tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn ntf) >>= \case
         Right _ -> do
           void $ liftIO $ setTknStatusConfirmed st tkn
           incNtfStatT t ntfVrfDelivered
         Left _ -> incNtfStatT t ntfVrfFailed
     PNCheckMessages -> do
-      liftIO (deliverNotification st pp tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn ntf) >>= \case
         Right _ -> do
           void $ liftIO $ updateTokenCronSentAt st ntfTknId . systemSeconds =<< getSystemTime
           incNtfStatT t ntfCronDelivered
@@ -649,7 +648,7 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
     PNMessage {} -> checkActiveTkn tknStatus $ do
       stats <- asks serverStats
       liftIO $ updatePeriodStats (activeTokens stats) ntfTknId
-      liftIO (deliverNotification st pp tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn ntf) >>= \case
         Left _ -> do
           incNtfStatT t ntfFailed
           liftIO $ mapM_ (`incServerStat` ntfFailedOwn stats) srvHost_
@@ -662,8 +661,8 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
     checkActiveTkn status action
       | status == NTActive = action
       | otherwise = liftIO $ logError "bad notification token status"
-    deliverNotification :: NtfPostgresStore -> PushProvider -> NtfTknRec -> PushNotification -> IO (Either PushProviderError ())
-    deliverNotification st pp tkn@NtfTknRec {ntfTknId} ntf = do
+    deliverNotification :: NtfPostgresStore -> NtfTknRec -> PushNotification -> IO (Either PushProviderError ())
+    deliverNotification st tkn@NtfTknRec {ntfTknId, token} ntf = do
       deliver <- getPushClient s pp
       runExceptT (deliver tkn ntf) >>= \case
         Right _ -> pure $ Right ()
@@ -679,6 +678,7 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
           PPInvalidPusher -> err e
           _ -> err e
       where
+        pp = tokenPushProvider token
         retryDeliver :: IO (Either PushProviderError ())
         retryDeliver = do
           deliver <- newPushClient s pp
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index ec7ae51664..83608ebcd8 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -164,26 +164,23 @@ newNtfPushServer qSize apnsConfig = do
 
 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 newPushClient s pp = do
-  case pp of
+  c <- case pp of
     PPWP p -> newWPPushClient s p
     PPAPNS p -> newAPNSPushClient s p
+  atomically $ TM.insert pp c $ pushClients s
+  pure c
 
 newAPNSPushClient :: NtfPushServer -> APNSProvider -> IO PushProviderClient
 newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do
-  c <- case apnsProviderHost pp of
+  case apnsProviderHost pp of
     Nothing -> pure $ \_ _ -> pure ()
     Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig
-  atomically $ TM.insert (PPAPNS pp) c pushClients
-  pure c
 
 newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient
 newWPPushClient NtfPushServer {pushClients} pp = do
   logDebug "New WP Client requested"
   -- We use one http manager per push server (which may be used by different clients)
-  manager <- wpHTTPManager
-  let c = wpPushProviderClient manager
-  atomically $ TM.insert (PPWP pp) c pushClients
-  pure c
+  wpPushProviderClient <$> wpHTTPManager
 
 wpHTTPManager :: IO Manager
 wpHTTPManager = newManager tlsManagerSettings {
@@ -191,7 +188,7 @@ wpHTTPManager = newManager tlsManagerSettings {
     -- disable requests to non-public IPs. The risk is very limited as
     -- we allow https only, and the body is encrypted. Disabling redirections
     -- avoids cross-protocol redir (https => http/unix)
-    managerModifyRequest = \r -> pure r { redirectCount = 0 }
+    managerModifyRequest = \r -> pure r {redirectCount = 0}
   }
 
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient

From 3402d64029ec2a80d3c89a672efd58c2aedb2e6c Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Thu, 30 Oct 2025 17:28:45 +0100
Subject: [PATCH 20/26] Move functions to encode/decode EC keys to Crypto
 module

---
 src/Simplex/Messaging/Crypto.hs               | 63 +++++++++++++++++++
 .../Messaging/Notifications/Protocol.hs       | 50 +--------------
 .../Messaging/Notifications/Server/Push.hs    |  9 ---
 .../Notifications/Server/Push/APNS.hs         |  2 +-
 .../Notifications/Server/Push/WebPush.hs      |  6 +-
 tests/NtfWPTests.hs                           |  2 +-
 6 files changed, 70 insertions(+), 62 deletions(-)

diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 1fa2c6d4c3..a214d9b2c8 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -87,6 +87,7 @@ module Simplex.Messaging.Crypto
     signatureKeyPair,
     publicToX509,
     encodeASNObj,
+    readECPrivateKey,
 
     -- * key encoding/decoding
     encodePubKey,
@@ -94,6 +95,9 @@ module Simplex.Messaging.Crypto
     encodePrivKey,
     decodePrivKey,
     pubKeyBytes,
+    uncompressEncodePoint,
+    uncompressDecodePoint,
+    uncompressDecodePrivateNumber,
 
     -- * sign/verify
     Signature (..),
@@ -252,6 +256,12 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll, parseString)
 import Simplex.Messaging.Util ((<$?>))
+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+import qualified Crypto.Store.PKCS8 as PK
+import qualified Crypto.PubKey.ECC.Types as ECC
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Binary as Bin
+import qualified Data.Bits as Bits
 
 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -1542,3 +1552,56 @@ keyError :: (a, [ASN1]) -> Either String b
 keyError = \case
   (_, []) -> Left "unknown key algorithm"
   _ -> Left "more than one key"
+
+readECPrivateKey :: FilePath -> IO ECDSA.PrivateKey
+readECPrivateKey f = do
+  -- this pattern match is specific to APNS key type, it may need to be extended for other push providers
+  [PK.Unprotected (X.PrivKeyEC X.PrivKeyEC_Named {privkeyEC_name, privkeyEC_priv})] <- PK.readKeyFile f
+  pure ECDSA.PrivateKey {private_curve = ECC.getCurveByName privkeyEC_name, private_d = privkeyEC_priv}
+
+-- | Elliptic-Curve-Point-to-Octet-String Conversion without compression
+-- | as required by RFC8291
+-- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3
+uncompressEncodePoint :: ECC.Point -> BL.ByteString
+uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y
+uncompressEncodePoint ECC.PointO = "\0"
+
+uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point
+uncompressDecodePoint "\0" = pure ECC.PointO
+uncompressDecodePoint s
+  | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported
+  | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid
+  | otherwise = do
+    let s' = BL.drop 1 s
+    x <- decodeBigInt $ BL.take 32 s'
+    y <- decodeBigInt $ BL.drop 32 s'
+    pure $ ECC.Point x y
+  where
+    prefix = "\x04" :: BL.ByteString
+
+-- Used to test encryption against the RFC8291 Example - which gives the AS private key
+uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber
+uncompressDecodePrivateNumber s
+  | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid
+  | otherwise = do
+    decodeBigInt s
+
+encodeBigInt :: Integer -> BL.ByteString
+encodeBigInt i = do
+  let s1 = Bits.shiftR i 64
+      s2 = Bits.shiftR s1 64
+      s3 = Bits.shiftR s2 64
+  Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
+  where
+    w64 :: Integer -> Bin.Word64
+    w64 = fromIntegral
+
+decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer
+decodeBigInt s
+  | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid
+  | otherwise = do
+      let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 )
+      pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0
+  where
+    shift i w = Bits.shiftL (fromIntegral w) (64 * i)
+
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 42e6c09db7..7957e0ad83 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -484,57 +484,11 @@ data WPKey = WPKey
   }
   deriving (Eq, Ord, Show)
 
--- | Elliptic-Curve-Point-to-Octet-String Conversion without compression
--- | as required by RFC8291
--- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3
-uncompressEncodePoint :: ECC.Point -> BL.ByteString
-uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y
-uncompressEncodePoint ECC.PointO = "\0"
-
-uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point
-uncompressDecodePoint "\0" = pure ECC.PointO
-uncompressDecodePoint s
-  | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported
-  | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid
-  | otherwise = do
-    let s' = BL.drop 1 s
-    x <- decodeBigInt $ BL.take 32 s'
-    y <- decodeBigInt $ BL.drop 32 s'
-    pure $ ECC.Point x y
-  where
-    prefix = "\x04" :: BL.ByteString
-
--- Used to test encryption against the RFC8291 Example - which gives the AS private key
-uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber
-uncompressDecodePrivateNumber s
-  | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid
-  | otherwise = do
-    decodeBigInt s
-
 uncompressEncode :: WPP256dh -> BL.ByteString
-uncompressEncode (WPP256dh p) = uncompressEncodePoint p
+uncompressEncode (WPP256dh p) = C.uncompressEncodePoint p
 
 uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh
-uncompressDecode bs = WPP256dh <$> uncompressDecodePoint bs
-
-encodeBigInt :: Integer -> BL.ByteString
-encodeBigInt i = do
-  let s1 = Bits.shiftR i 64
-      s2 = Bits.shiftR s1 64
-      s3 = Bits.shiftR s2 64
-  Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
-  where
-    w64 :: Integer -> Bin.Word64
-    w64 = fromIntegral
-
-decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer
-decodeBigInt s
-  | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid
-  | otherwise = do
-      let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 )
-      pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0
-  where
-    shift i w = Bits.shiftL (fromIntegral w) (64 * i)
+uncompressDecode bs = WPP256dh <$> C.uncompressDecodePoint bs
 
 data WPTokenParams = WPTokenParams
   { wpPath :: ByteString,
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index a2a954b085..1f3579545d 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -12,8 +12,6 @@ module Simplex.Messaging.Notifications.Server.Push where
 
 import Crypto.Hash.Algorithms (SHA256 (..))
 import qualified Crypto.PubKey.ECC.ECDSA as EC
-import qualified Crypto.PubKey.ECC.Types as ECT
-import qualified Crypto.Store.PKCS8 as PK
 import Data.ASN1.BinaryEncoding (DER (..))
 import Data.ASN1.Encoding
 import Data.ASN1.Types
@@ -27,7 +25,6 @@ import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text (Text)
 import Data.Time.Clock.System
-import qualified Data.X509 as X
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError)
@@ -74,12 +71,6 @@ signedJWTToken pk (JWTToken hdr claims) = do
     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
-  -- this pattern match is specific to APNS key type, it may need to be extended for other push providers
-  [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 (NonEmpty PNMessageData)
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 24652c81e7..4e6b099e18 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -160,7 +160,7 @@ createAPNSPushClient :: HostName -> APNSPushClientConfig -> IO APNSPushClient
 createAPNSPushClient apnsHost apnsCfg@APNSPushClientConfig {authKeyFileEnv, authKeyAlg, authKeyIdEnv, appTeamId} = do
   https2Client <- newTVarIO Nothing
   void $ connectHTTPS2 apnsHost apnsCfg https2Client
-  privateKey <- readECPrivateKey =<< getEnv authKeyFileEnv
+  privateKey <- C.readECPrivateKey =<< getEnv authKeyFileEnv
   authKeyId <- T.pack <$> getEnv authKeyIdEnv
   let jwtHeader = JWTHeader {alg = authKeyAlg, kid = authKeyId}
   jwtToken <- newTVarIO =<< mkApnsJWTToken appTeamId jwtHeader privateKey
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 9b1ebb9f8d..c729cecc25 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -10,7 +10,7 @@ module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
 import Network.HTTP.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -72,8 +72,8 @@ wpEncrypt wpKey clearT = do
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
 wpEncrypt' :: WPKey -> ECC.PrivateNumber -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
 wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do
-  let uaPubKS = BL.toStrict . uncompressEncodePoint $ uaPubK
-  let asPubKS = BL.toStrict . uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
+  let uaPubKS = BL.toStrict . C.uncompressEncodePoint $ uaPubK
+  let asPubKS = BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
       ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK
       prkKey = hmac (unWPAuth wpAuth) ecdhSecret
       keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS
diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 8a5fcf1803..64d04f86e9 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -65,7 +65,7 @@ testWPEncryption = do
   let pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4"
   let salt :: B.ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw"
   let privBS :: BL.ByteString = either error BL.fromStrict $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw"
-  asPriv :: ECC.PrivateNumber <- case uncompressDecodePrivateNumber privBS of
+  asPriv :: ECC.PrivateNumber <- case C.uncompressDecodePrivateNumber privBS of
     Left e -> fail $ "Cannot decode PrivateNumber from b64 " <> show e
     Right p -> pure p
   mCip <- runExceptT $ wpEncrypt' (wpKey pParams) asPriv salt clearT

From c50c77dbade4938dd9f01718721469b5b313a32f Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 07:47:22 +0100
Subject: [PATCH 21/26] Add WebPush config with VAPID key to NTF server

---
 .../Messaging/Notifications/Server/Env.hs     | 16 +++---
 .../Messaging/Notifications/Server/Main.hs    | 28 ++++++++--
 .../Notifications/Server/Push/WebPush.hs      | 20 +++++++
 tests/AgentTests/NotificationTests.hs         | 54 +++++++++++--------
 tests/NtfClient.hs                            | 28 ++++++----
 tests/fixtures/vapid.privkey                  |  5 ++
 6 files changed, 108 insertions(+), 43 deletions(-)
 create mode 100644 tests/fixtures/vapid.privkey

diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 83608ebcd8..b15e45d83f 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -46,7 +46,7 @@ import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, Transport
 import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
-import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient, WebPushConfig)
 import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 
@@ -61,6 +61,7 @@ data NtfServerConfig = NtfServerConfig
     pushQSize :: Natural,
     smpAgentCfg :: SMPClientAgentConfig,
     apnsConfig :: APNSPushClientConfig,
+    wpConfig :: WebPushConfig,
     subsBatchSize :: Int,
     inactiveClientExpiration :: Maybe ExpirationConfig,
     dbStoreConfig :: PostgresStoreCfg,
@@ -100,7 +101,7 @@ data NtfEnv = NtfEnv
   }
 
 newNtfServerEnv :: NtfServerConfig -> IO NtfEnv
-newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbStoreConfig, ntfCredentials, useServiceCreds, startOptions} = do
+newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, wpConfig, dbStoreConfig, ntfCredentials, useServiceCreds, startOptions} = do
   when (compactLog startOptions) $ compactDbStoreLog $ dbStoreLogPath dbStoreConfig
   random <- C.newRandom
   store <- newNtfDbStore dbStoreConfig
@@ -116,7 +117,7 @@ newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbSt
         pure smpAgentCfg {smpCfg = (smpCfg smpAgentCfg) {serviceCredentials = Just service}}
       else pure smpAgentCfg
   subscriber <- newNtfSubscriber smpAgentCfg' random
-  pushServer <- newNtfPushServer pushQSize apnsConfig
+  pushServer <- newNtfPushServer pushQSize apnsConfig wpConfig
   serverStats <- newNtfServerStats =<< getCurrentTime
   pure NtfEnv {config, subscriber, pushServer, store, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
   where
@@ -153,14 +154,15 @@ data SMPSubscriber = SMPSubscriber
 data NtfPushServer = NtfPushServer
   { pushQ :: TBQueue (Maybe T.Text, NtfTknRec, PushNotification), -- Maybe Text is a hostname of "own" server
     pushClients :: TMap PushProvider PushProviderClient,
-    apnsConfig :: APNSPushClientConfig
+    apnsConfig :: APNSPushClientConfig,
+    wpConfig :: WebPushConfig
   }
 
-newNtfPushServer :: Natural -> APNSPushClientConfig -> IO NtfPushServer
-newNtfPushServer qSize apnsConfig = do
+newNtfPushServer :: Natural -> APNSPushClientConfig -> WebPushConfig -> IO NtfPushServer
+newNtfPushServer qSize apnsConfig wpConfig = do
   pushQ <- newTBQueueIO qSize
   pushClients <- TM.emptyIO
-  pure NtfPushServer {pushQ, pushClients, apnsConfig}
+  pure NtfPushServer {pushQ, pushClients, apnsConfig, wpConfig}
 
 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 newPushClient s pp = do
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index de12c33f89..fd54680ba9 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -11,7 +11,7 @@
 module Simplex.Messaging.Notifications.Server.Main where
 
 import Control.Logger.Simple (setLogLevel)
-import Control.Monad ((<$!>))
+import Control.Monad ( (<$!>), unless, void )
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
@@ -56,6 +56,8 @@ import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)
+import System.Process (readCreateProcess, shell)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig(..), VapidKey, mkVapid)
 
 ntfServerCLI :: FilePath -> FilePath -> IO ()
 ntfServerCLI cfgPath logPath =
@@ -146,6 +148,7 @@ ntfServerCLI cfgPath logPath =
       clearDirIfExists logPath
       createDirectoryIfMissing True cfgPath
       createDirectoryIfMissing True logPath
+      _ <- genVapidKey vapidKeyPath
       let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
       fp <- createServerX509 cfgPath x509cfg
       let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
@@ -212,9 +215,10 @@ ntfServerCLI cfgPath logPath =
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
       fp <- checkSavedFingerprint cfgPath defaultX509Config
+      vapidKey <- getVapidKey vapidKeyPath
       let host = either (const "<hostnames>") T.unpack $ lookupValue "TRANSPORT" "host" ini
           port = T.unpack $ strictIni "TRANSPORT" "port" ini
-          cfg@NtfServerConfig {transports} = serverConfig
+          cfg@NtfServerConfig {transports} = serverConfig vapidKey
           srv = ProtoServerWithAuth (NtfServer [THDomainName host] (if port == "443" then "" else port) (C.KeyHash fp)) Nothing
       printServiceInfo serverVersion srv
       printNtfServerConfig transports dbStoreConfig
@@ -230,7 +234,7 @@ ntfServerCLI cfgPath logPath =
               confirmMigrations = MCYesUp,
               deletedTTL = iniDeletedTTL ini
             }
-        serverConfig =
+        serverConfig vapidKey =
           NtfServerConfig
             { transports = iniTransports ini,
               controlPort = either (const Nothing) (Just . T.unpack) $ lookupValue "TRANSPORT" "control_port" ini,
@@ -258,6 +262,7 @@ ntfServerCLI cfgPath logPath =
                     persistErrorInterval = 0 -- seconds
                   },
               apnsConfig = defaultAPNSPushClientConfig,
+              wpConfig = WebPushConfig {vapidKey},
               subsBatchSize = 900,
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
@@ -294,6 +299,7 @@ ntfServerCLI cfgPath logPath =
       putStrLn $ "Error: both " <> storeLogFilePath <> " file and " <> B.unpack schema <> " schema are present (database: " <> B.unpack connstr <> ")."
       putStrLn "Configure notification server storage."
       exitFailure
+    vapidKeyPath = combine cfgPath "vapid.privkey"
 
 printNtfServerConfig :: [(ServiceName, ASrvTransport, AddHTTP)] -> PostgresStoreCfg -> IO ()
 printNtfServerConfig transports PostgresStoreCfg {dbOpts = DBOpts {connstr, schema}, dbStoreLogPath} = do
@@ -395,3 +401,19 @@ cliCommandP cfgPath logPath iniFile =
               <> metavar "FQDN"
           )
       pure InitOptions {enableStoreLog, dbOptions, signAlgorithm, ip, fqdn}
+
+genVapidKey :: FilePath -> IO VapidKey
+genVapidKey file = do
+  cfgExists <- doesFileExist file
+  unless cfgExists $ run $ "openssl ecparam -name prime256v1 -genkey -noout -out " <> file
+  key <- C.readECPrivateKey file
+  pure $ mkVapid key
+  where
+    run cmd = void $ readCreateProcess (shell cmd) ""
+
+getVapidKey :: FilePath -> IO VapidKey
+getVapidKey file = do
+  cfgExists <- doesFileExist file
+  unless cfgExists $ error $ "VAPID key not found: " <> file
+  key <- C.readECPrivateKey file
+  pure $ mkVapid key
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index c729cecc25..959eb3fd69 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -32,6 +32,26 @@ import qualified Crypto.Cipher.Types as CT
 import qualified Crypto.MAC.HMAC as HMAC
 import qualified Crypto.PubKey.ECC.DH as ECDH
 import qualified Crypto.PubKey.ECC.Types as ECC
+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+import qualified Data.ByteString.Base64.URL as B64
+
+-- | Vapid
+-- | fp: fingerprint, base64url encoded without padding
+-- | key: privkey
+data VapidKey = VapidKey
+  { key::ECDSA.PrivateKey,
+    fp::B.ByteString
+  }
+  deriving (Eq, Show)
+
+mkVapid :: ECDSA.PrivateKey -> VapidKey
+mkVapid key = VapidKey { key, fp }
+  where
+    fp = B64.encodeUnpadded . B.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key
+
+data WebPushConfig = WebPushConfig
+  { vapidKey :: VapidKey
+  }
 
 wpPushProviderClient :: Manager -> PushProviderClient
 wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 0912e29b27..5b495c7834 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -205,8 +205,9 @@ checkNtfToken c = A.checkNtfToken c NRMInteractive
 verifyNtfToken :: AgentClient -> DeviceToken -> C.CbNonce -> ByteString -> AE ()
 verifyNtfToken c = A.verifyNtfToken c NRMInteractive
 
-runNtfTestCfg :: HasCallStack => (ASrvTransport, AStoreType) -> AgentMsgId -> AServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO ()
-runNtfTestCfg (t, msType) baseId smpCfg ntfCfg aCfg bCfg runTest = do
+runNtfTestCfg :: HasCallStack => (ASrvTransport, AStoreType) -> AgentMsgId -> AServerConfig -> IO NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO ()
+runNtfTestCfg (t, msType) baseId smpCfg ntfCfg' aCfg bCfg runTest = do
+  ntfCfg <- ntfCfg'
   ASSCfg qt mt serverStoreCfg <- pure $ testServerStoreConfig msType
   let smpCfg' = withServerCfg smpCfg $ \cfg_ -> ASrvCfg qt mt cfg_ {serverStoreCfg}
   withSmpServerConfigOn t smpCfg' testPort $ \_ ->
@@ -931,7 +932,8 @@ testMigrateToServiceSubscriptions :: HasCallStack => (ASrvTransport, AStoreType)
 testMigrateToServiceSubscriptions ps@(t, msType) = withAgentClients2 $ \a b -> do
   (c1, c2, c3) <- withSmpServerConfigOn t cfgNoService testPort $ \_ -> do
     (c1, c2) <- withAPNSMockServer $ \apns -> do
-      withNtfServerCfg ntfCfgNoService $ \_ -> runRight $ do
+      cfg' <- ntfCfgNoService
+      withNtfServerCfg cfg' $ \_ -> runRight $ do
         _tkn <- registerTestToken a "abcd" NMInstant apns
         -- create 2 connections with ntfs, test delivery
         c1 <- testConnectMsg apns a b "hello"
@@ -970,27 +972,31 @@ testMigrateToServiceSubscriptions ps@(t, msType) = withAgentClients2 $ \a b -> d
   serverDOWN a b 5
 
   -- Ntf server does not use server, subscriptions downgrade
-  c6 <- withAPNSMockServer $ \apns -> withSmpServer ps $ withNtfServerCfg ntfCfgNoService $ \_ -> do
-    serverUP a b 5
-    runRight $ do
-      testSendMsg apns a b c1 "msg 1"
-      testSendMsg apns a b c2 "msg 2"
-      testSendMsg apns a b c3 "msg 3"
-      testSendMsg apns a b c4 "msg 4"
-      testSendMsg apns a b c5 "msg 5"
-      testConnectMsg apns a b "msg 6"
+  c6 <- withAPNSMockServer $ \apns -> do
+    cfg' <- ntfCfgNoService
+    withSmpServer ps $ withNtfServerCfg cfg' $ \_ -> do
+      serverUP a b 5
+      runRight $ do
+        testSendMsg apns a b c1 "msg 1"
+        testSendMsg apns a b c2 "msg 2"
+        testSendMsg apns a b c3 "msg 3"
+        testSendMsg apns a b c4 "msg 4"
+        testSendMsg apns a b c5 "msg 5"
+        testConnectMsg apns a b "msg 6"
   serverDOWN a b 6
 
-  withAPNSMockServer $ \apns -> withSmpServerConfigOn t cfgNoService testPort $ \_ -> withNtfServerCfg ntfCfgNoService $ \_ -> do
-    serverUP a b 6
-    runRight_ $ do
-      testSendMsg apns a b c1 "1"
-      testSendMsg apns a b c2 "2"
-      testSendMsg apns a b c3 "3"
-      testSendMsg apns a b c4 "4"
-      testSendMsg apns a b c5 "5"
-      testSendMsg apns a b c6 "6"
-      void $ testConnectMsg apns a b "7"
+  withAPNSMockServer $ \apns -> do
+    cfg' <- ntfCfgNoService
+    withSmpServerConfigOn t cfgNoService testPort $ \_ -> withNtfServerCfg cfg' $ \_ -> do
+      serverUP a b 6
+      runRight_ $ do
+        testSendMsg apns a b c1 "1"
+        testSendMsg apns a b c2 "2"
+        testSendMsg apns a b c3 "3"
+        testSendMsg apns a b c4 "4"
+        testSendMsg apns a b c5 "5"
+        testSendMsg apns a b c6 "6"
+        void $ testConnectMsg apns a b "7"
   serverDOWN a b 7
   where
     testConnectMsg apns a b msg = do
@@ -1013,7 +1019,9 @@ testMigrateToServiceSubscriptions ps@(t, msType) = withAgentClients2 $ \a b -> d
     cfgNoService = updateCfg (cfgMS msType) $ \(cfg' :: ServerConfig s) ->
       let ServerConfig {transportConfig} = cfg'
        in cfg' {transportConfig = transportConfig {askClientCert = False}} :: ServerConfig s
-    ntfCfgNoService = ntfServerCfg {useServiceCreds = False, transports = [(ntfTestPort, t, False)]}
+    ntfCfgNoService = do
+      cfg' <- ntfServerCfg
+      pure cfg' {useServiceCreds = False, transports = [(ntfTestPort, t, False)]}
 
 testMessage_ :: HasCallStack => APNSMockServer -> AgentClient -> ConnId -> AgentClient -> ConnId -> SMP.MsgBody -> ExceptT AgentErrorType IO ()
 testMessage_ apns a aId b bId msg = do
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index bdd57f61c1..275d0bab0a 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -61,6 +61,8 @@ import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 import Control.Exception (throwIO)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig(..))
+import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
 
 testHost :: NonEmpty TransportHost
 testHost = "localhost"
@@ -125,9 +127,10 @@ testNtfClient client = do
       Right th -> client th
       Left e -> error $ show e
 
-ntfServerCfg :: NtfServerConfig
-ntfServerCfg =
-  NtfServerConfig
+ntfServerCfg :: IO NtfServerConfig
+ntfServerCfg = do
+  vapidKey <- getVapidKey "tests/fixtures/vapid.privkey"
+  pure NtfServerConfig
     { transports = [],
       controlPort = Nothing,
       controlPortUserAuth = Nothing,
@@ -142,6 +145,7 @@ ntfServerCfg =
           { apnsPort = apnsTestPort,
             caStoreFile = "tests/fixtures/ca.crt"
           },
+      wpConfig = WebPushConfig {vapidKey},
       subsBatchSize = 900,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       dbStoreConfig = ntfTestDBCfg,
@@ -160,20 +164,24 @@ ntfServerCfg =
       startOptions = defaultStartOptions
     }
 
-ntfServerCfgVPrev :: NtfServerConfig
-ntfServerCfgVPrev =
-  ntfServerCfg
-    { ntfServerVRange = prevRange $ ntfServerVRange ntfServerCfg,
+ntfServerCfgVPrev :: IO NtfServerConfig
+ntfServerCfgVPrev = ntfServerCfg >>=
+  \cfg -> pure $ ntfServerCfgVPrev' cfg
+
+ntfServerCfgVPrev' :: NtfServerConfig -> NtfServerConfig
+ntfServerCfgVPrev' cfg =
+  cfg
+    { ntfServerVRange = prevRange $ ntfServerVRange cfg,
       smpAgentCfg = smpAgentCfg' {smpCfg = smpCfg' {serverVRange = prevRange serverVRange'}}
     }
   where
-    smpAgentCfg' = smpAgentCfg ntfServerCfg
+    smpAgentCfg' = smpAgentCfg cfg
     smpCfg' = smpCfg smpAgentCfg'
     serverVRange' = serverVRange smpCfg'
 
 withNtfServerThreadOn :: HasCallStack => ASrvTransport -> ServiceName -> PostgresStoreCfg -> (HasCallStack => ThreadId -> IO a) -> IO a
-withNtfServerThreadOn t port' dbStoreConfig =
-  withNtfServerCfg ntfServerCfg {transports = [(port', t, False)], dbStoreConfig}
+withNtfServerThreadOn t port' dbStoreConfig a = ntfServerCfg >>= \cfg ->
+  withNtfServerCfg cfg {transports = [(port', t, False)], dbStoreConfig} a
 
 withNtfServerCfg :: HasCallStack => NtfServerConfig -> (ThreadId -> IO a) -> IO a
 withNtfServerCfg cfg@NtfServerConfig {transports} =
diff --git a/tests/fixtures/vapid.privkey b/tests/fixtures/vapid.privkey
new file mode 100644
index 0000000000..294260c2d6
--- /dev/null
+++ b/tests/fixtures/vapid.privkey
@@ -0,0 +1,5 @@
+-----BEGIN EC PRIVATE KEY-----
+MHcCAQEEIMTAncBq2I7G3KvW4C8Y8Heg2cbcDTobbGFQFnBiA5M/oAoGCCqGSM49
+AwEHoUQDQgAEiTsBKQSvUDWslEZcwqLvu0AaPd1Gi5KBl1bpLml57treHt+S93Q5
+hCLHLjKPflQVm3yF31PABCLJsMr8ckvAkA==
+-----END EC PRIVATE KEY-----

From 49a7e26a2fa23e0ad5f6a98de61a837169995df2 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 09:16:58 +0100
Subject: [PATCH 22/26] Send VAPID header with webpush requests

---
 .../Messaging/Notifications/Protocol.hs       |  3 +
 .../Messaging/Notifications/Server/Env.hs     |  7 +-
 .../Messaging/Notifications/Server/Push.hs    | 34 +++++++--
 .../Notifications/Server/Push/APNS.hs         |  5 +-
 .../Notifications/Server/Push/WebPush.hs      | 73 +++++++++++++++++--
 tests/NtfWPTests.hs                           | 32 +++++++-
 6 files changed, 139 insertions(+), 15 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 7957e0ad83..dfc18013ef 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -394,6 +394,9 @@ newtype WPSrvLoc = WPSrvLoc SrvLoc
 newtype WPProvider = WPP WPSrvLoc
   deriving (Eq, Ord, Show)
 
+wpAud :: WPProvider -> B.ByteString
+wpAud (WPP (WPSrvLoc (SrvLoc aud _))) = B.pack aud
+
 instance Encoding PushProvider where
   smpEncode = \case
     PPAPNS p -> smpEncode p
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index b15e45d83f..1b3ad1230f 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -49,6 +49,7 @@ import UnliftIO.STM
 import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient, WebPushConfig)
 import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Data.IORef (newIORef)
 
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ASrvTransport, AddHTTP)],
@@ -179,10 +180,12 @@ newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do
     Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig
 
 newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient
-newWPPushClient NtfPushServer {pushClients} pp = do
+newWPPushClient NtfPushServer {wpConfig, pushClients} pp = do
   logDebug "New WP Client requested"
   -- We use one http manager per push server (which may be used by different clients)
-  wpPushProviderClient <$> wpHTTPManager
+  manager <- wpHTTPManager
+  cache <- newIORef Nothing
+  pure $ wpPushProviderClient wpConfig cache manager
 
 wpHTTPManager :: IO Manager
 wpHTTPManager = newManager tlsManagerSettings {
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index 1f3579545d..1039e54484 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -12,6 +12,8 @@ module Simplex.Messaging.Notifications.Server.Push where
 
 import Crypto.Hash.Algorithms (SHA256 (..))
 import qualified Crypto.PubKey.ECC.ECDSA as EC
+import qualified Crypto.PubKey.ECC.Types as ECT
+import qualified Crypto.Store.PKCS8 as PK
 import Data.ASN1.BinaryEncoding (DER (..))
 import Data.ASN1.Encoding
 import Data.ASN1.Types
@@ -25,6 +27,7 @@ import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text (Text)
 import Data.Time.Clock.System
+import qualified Data.X509 as X
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError)
@@ -36,14 +39,21 @@ import Control.Monad.Except (ExceptT)
 import GHC.Exception (SomeException)
 
 data JWTHeader = JWTHeader
-  { alg :: Text, -- key algorithm, ES256 for APNS
-    kid :: Text -- key ID
+  { typ :: Text, -- "JWT"
+    alg :: Text, -- key algorithm, ES256 for APNS
+    kid :: Maybe Text -- key ID
   }
   deriving (Show)
 
+mkJWTHeader :: Text -> Maybe Text -> JWTHeader
+mkJWTHeader alg kid = JWTHeader { typ = "JWT", alg, kid }
+
 data JWTClaims = JWTClaims
-  { iss :: Text, -- issuer, team ID for APNS
-    iat :: Int64 -- issue time, seconds from epoch
+  { iss :: Maybe Text, -- issuer, team ID for APNS
+    iat :: Maybe Int64, -- issue time, seconds from epoch for APNS
+    exp :: Maybe Int64, -- expired time, seconds from epoch for web push
+    aud :: Maybe Text, -- audience, for web push
+    sub :: Maybe Text -- subject, to be inform if there is an issue, for web push
   }
   deriving (Show)
 
@@ -53,7 +63,15 @@ data JWTToken = JWTToken JWTHeader JWTClaims
 mkJWTToken :: JWTHeader -> Text -> IO JWTToken
 mkJWTToken hdr iss = do
   iat <- systemSeconds <$> getSystemTime
-  pure $ JWTToken hdr JWTClaims {iss, iat}
+  pure $ JWTToken hdr $ jwtClaims iat
+  where
+    jwtClaims iat = JWTClaims
+      { iss = Just iss,
+        iat = Just iat,
+        exp = Nothing,
+        aud = Nothing,
+        sub = Nothing
+      }
 
 type SignedJWTToken = ByteString
 
@@ -71,6 +89,12 @@ signedJWTToken pk (JWTToken hdr claims) = do
     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
+  -- this pattern match is specific to APNS key type, it may need to be extended for other push providers
+  [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 (NonEmpty PNMessageData)
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 4e6b099e18..929360b53a 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -162,7 +162,7 @@ createAPNSPushClient apnsHost apnsCfg@APNSPushClientConfig {authKeyFileEnv, auth
   void $ connectHTTPS2 apnsHost apnsCfg https2Client
   privateKey <- C.readECPrivateKey =<< getEnv authKeyFileEnv
   authKeyId <- T.pack <$> getEnv authKeyIdEnv
-  let jwtHeader = JWTHeader {alg = authKeyAlg, kid = authKeyId}
+  let jwtHeader = mkJWTHeader authKeyAlg (Just authKeyId)
   jwtToken <- newTVarIO =<< mkApnsJWTToken appTeamId jwtHeader privateKey
   nonceDrg <- C.newRandom
   pure APNSPushClient {https2Client, privateKey, jwtHeader, jwtToken, nonceDrg, apnsHost, apnsCfg}
@@ -178,7 +178,8 @@ getApnsJWTToken APNSPushClient {apnsCfg = APNSPushClientConfig {appTeamId, token
       atomically $ writeTVar jwtToken t
       pure signedJWT'
   where
-    jwtTokenAge (JWTToken _ JWTClaims {iat}) = subtract iat . systemSeconds <$> getSystemTime
+    jwtTokenAge (JWTToken _ JWTClaims {iat = Just iat}) = subtract iat . systemSeconds <$> getSystemTime
+    jwtTokenAge (JWTToken _ JWTClaims {iat = Nothing}) = pure maxBound :: IO Int64
 
 mkApnsJWTToken :: Text -> JWTHeader -> EC.PrivateKey -> IO (JWTToken, SignedJWTToken)
 mkApnsJWTToken appTeamId jwtHeader privateKey = do
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 959eb3fd69..704726380c 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -10,7 +10,7 @@ module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
 import Network.HTTP.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest, wpAud)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -34,6 +34,10 @@ import qualified Crypto.PubKey.ECC.DH as ECDH
 import qualified Crypto.PubKey.ECC.Types as ECC
 import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
 import qualified Data.ByteString.Base64.URL as B64
+import Data.IORef
+import Data.Int (Int64)
+import Data.Time.Clock.System (systemSeconds, getSystemTime)
+import qualified Data.Text.Encoding as T
 
 -- | Vapid
 -- | fp: fingerprint, base64url encoded without padding
@@ -53,18 +57,76 @@ data WebPushConfig = WebPushConfig
   { vapidKey :: VapidKey
   }
 
-wpPushProviderClient :: Manager -> PushProviderClient
-wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
-wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = do
+data WPCache = WPCache
+  { vapidHeader :: B.ByteString,
+    expire :: Int64
+  }
+
+getVapidHeader :: VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString
+getVapidHeader vapidK cache uriAuthority = do
+  h <- readIORef cache
+  now <- systemSeconds <$> getSystemTime
+  case h of
+    Nothing -> newCacheEntry now
+    Just entry -> if expire entry > now then pure $ vapidHeader entry
+      else newCacheEntry now
+  where
+    newCacheEntry :: Int64 -> IO B.ByteString
+    newCacheEntry now = do
+      -- The new entry expires in one hour
+      let expire = now + 3600
+      vapidHeader <- mkVapidHeader vapidK uriAuthority expire
+      let entry = Just WPCache { vapidHeader, expire }
+      atomicWriteIORef cache entry
+      pure vapidHeader
+
+-- | With time in input for the tests
+getVapidHeader' :: Int64 -> VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString
+getVapidHeader' now vapidK cache uriAuthority = do
+  h <- readIORef cache
+  case h of
+    Nothing -> newCacheEntry
+    Just entry -> if expire entry > now then pure $ vapidHeader entry
+      else newCacheEntry
+  where
+    newCacheEntry :: IO B.ByteString
+    newCacheEntry = do
+      -- The new entry expires in one hour
+      let expire = now + 3600
+      vapidHeader <- mkVapidHeader vapidK uriAuthority expire
+      let entry = Just WPCache { vapidHeader, expire }
+      atomicWriteIORef cache entry
+      pure vapidHeader
+
+-- | mkVapidHeader -> vapid -> endpoint -> expire -> vapid header
+mkVapidHeader :: VapidKey -> B.ByteString -> Int64 -> IO B.ByteString
+mkVapidHeader VapidKey {key, fp} uriAuthority expire = do
+  let jwtHeader = mkJWTHeader "ES256" Nothing
+      jwtClaims = JWTClaims
+        { iss = Nothing,
+          iat = Nothing,
+          exp = Just expire,
+          aud = Just $ T.decodeUtf8 uriAuthority,
+          sub = Just "https://github.com/simplex-chat/simplexmq/"
+        }
+      jwt = JWTToken jwtHeader jwtClaims
+  signedToken <- signedJWTToken key jwt
+  pure $ "vapid t=" <> signedToken <> ",k=" <> fp
+
+wpPushProviderClient :: WebPushConfig -> IORef (Maybe WPCache) -> Manager -> PushProviderClient
+wpPushProviderClient _ _ _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
+wpPushProviderClient conf cache mg NtfTknRec {token = token@(WPDeviceToken pp param)} pn = do
   -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
   -- parsing will happen in DeviceToken parser, so it won't fail here
   r <- wpRequest token
+  vapidH <- liftPPWPError $ getVapidHeader (vapidKey conf) cache aud
   logDebug $ "Request to " <> tshow (host r)
   encBody <- body
   let requestHeaders =
         [ ("TTL", "2592000"), -- 30 days
           ("Urgency", "high"),
-          ("Content-Encoding", "aes128gcm")
+          ("Content-Encoding", "aes128gcm"),
+          ("Authorization", vapidH)
     -- TODO: topic for pings and interval
         ]
       req =
@@ -79,6 +141,7 @@ wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = d
   where
     body :: ExceptT PushProviderError IO B.ByteString
     body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn)
+    aud = wpAud pp
 
 -- | encrypt :: UA key -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 64d04f86e9..b884c964be 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -10,7 +10,7 @@ import Simplex.Messaging.Encoding.String (StrEncoding(..))
 import qualified Data.ByteString as B
 import qualified Crypto.PubKey.ECC.Types as ECC
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN, getVapidHeader')
 import Control.Monad.Except (runExceptT)
 import qualified Data.ByteString.Lazy as BL
 import Simplex.Messaging.Notifications.Server.Push
@@ -18,6 +18,9 @@ import Data.List.NonEmpty (NonEmpty ((:|)))
 import qualified Simplex.Messaging.Crypto as C
 import Data.Time.Clock.System (SystemTime(..))
 import Data.Either (isLeft)
+import Data.IORef (newIORef)
+import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
+import Control.Monad (unless)
 
 ntfWPTests :: Spec
 ntfWPTests = describe "NTF Protocol" $ do
@@ -25,6 +28,7 @@ ntfWPTests = describe "NTF Protocol" $ do
   it "decode invalid WPDeviceToken" testInvalidWPDeviceTokenStrEncoding
   it "Encrypt RFC8291 example" testWPEncryption
   it "PushNotifications encoding" testPNEncoding
+  it "Vapid header cache" testVapidCache
 
 testWPDeviceTokenStrEncoding :: Expectation
 testWPDeviceTokenStrEncoding = do
@@ -89,3 +93,29 @@ testPNEncoding = do
       let smpQ = either error id $ strDecode "smp://AAAA@l/AAAA"
       let now = MkSystemTime 1761827386 0
       PNMessage $ PNMessageData smpQ now (C.cbNonce "nonce") m :| []
+
+testVapidCache :: Expectation
+testVapidCache = do
+  let wpaud = "https://localhost"
+  let now = 1761900906
+  cache <- newIORef Nothing
+  vapidKey <- getVapidKey "tests/fixtures/vapid.privkey"
+  v1 <- getVapidHeader' now vapidKey cache wpaud
+  v2 <- getVapidHeader' now vapidKey cache wpaud
+  v1 `shouldBe` v2
+  -- we just don't test the signature here
+  v1 `shouldContainBS` "vapid t=eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9.eyJleHAiOjE3NjE5MDQ1MDYsImF1ZCI6Imh0dHBzOi8vbG9jYWxob3N0Iiwic3ViIjoiaHR0cHM6Ly9naXRodWIuY29tL3NpbXBsZXgtY2hhdC9zaW1wbGV4bXEvIn0."
+  v1 `shouldContainBS` ",k=BIk7ASkEr1A1rJRGXMKi77tAGj3dRouSgZdW6S5pee7a3h7fkvd0OYQixy4yj35UFZt8hd9TwAQiybDK_HJLwJA"
+  v3 <- getVapidHeader' (now + 3600) vapidKey cache wpaud
+  v1 `shouldNotBe` v3
+  v3 `shouldContainBS` "vapid t=eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9."
+  v3 `shouldContainBS` ",k=BIk7ASkEr1A1rJRGXMKi77tAGj3dRouSgZdW6S5pee7a3h7fkvd0OYQixy4yj35UFZt8hd9TwAQiybDK_HJLwJA"
+
+shouldContainBS :: B.ByteString -> B.ByteString -> Expectation
+shouldContainBS actual expected =
+  unless (expected `B.isInfixOf` actual) $
+    expectationFailure $
+      "Expected ByteString to contain:\n" ++
+      show expected ++
+      "\nBut got:\n" ++
+      show actual

From 28aa2da55c4787f05929835319b8d8d91788fbdc Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 09:32:19 +0100
Subject: [PATCH 23/26] Add safety delay for VAPID header expirity

---
 src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 704726380c..7794deb473 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -68,7 +68,8 @@ getVapidHeader vapidK cache uriAuthority = do
   now <- systemSeconds <$> getSystemTime
   case h of
     Nothing -> newCacheEntry now
-    Just entry -> if expire entry > now then pure $ vapidHeader entry
+    -- if it expires in 1 min, then we renew - for safety
+    Just entry -> if expire entry > now + 60 then pure $ vapidHeader entry
       else newCacheEntry now
   where
     newCacheEntry :: Int64 -> IO B.ByteString

From 323d6daadf5794545482e278749fdd9fcd38a330 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 10:00:56 +0100
Subject: [PATCH 24/26] Fix compilation with GHC 8

---
 src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 7794deb473..184d07a380 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -16,7 +16,7 @@ import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
 import Control.Logger.Simple (logDebug)
 import Simplex.Messaging.Util (tshow)
-import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString as B
 import Control.Monad.IO.Class (liftIO)
 import Control.Exception ( fromException, SomeException, try )
 import qualified Network.HTTP.Types as N
@@ -51,7 +51,7 @@ data VapidKey = VapidKey
 mkVapid :: ECDSA.PrivateKey -> VapidKey
 mkVapid key = VapidKey { key, fp }
   where
-    fp = B64.encodeUnpadded . B.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key
+    fp = B64.encodeUnpadded . BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key
 
 data WebPushConfig = WebPushConfig
   { vapidKey :: VapidKey

From 229c8956d9e606ea49f77f38b71877d20123a51c Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 19 Jan 2026 20:22:23 +0000
Subject: [PATCH 25/26] ntf: e2e encrypt notifications, clean up encryption
 (#1698)

---
 src/Simplex/Messaging/Crypto.hs               |  68 +++---
 .../Messaging/Notifications/Protocol.hs       |  36 ++--
 .../Messaging/Notifications/Server/Env.hs     |  30 +--
 .../Messaging/Notifications/Server/Main.hs    |   6 +-
 .../Notifications/Server/Push/WebPush.hs      | 199 +++++++++---------
 tests/NtfClient.hs                            |  83 ++++----
 tests/NtfWPTests.hs                           |  64 ++----
 7 files changed, 240 insertions(+), 246 deletions(-)

diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index a214d9b2c8..05c6b32e9b 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -215,24 +215,29 @@ import Control.Exception (Exception)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Trans.Except
-import Crypto.Cipher.AES (AES256, AES128)
+import Crypto.Cipher.AES (AES128, AES256)
 import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
-import Crypto.Hash (Digest, SHA3_256, SHA3_384, SHA256 (..), SHA512 (..), hash, hashDigestSize)
+import Crypto.Hash (Digest, SHA256 (..), SHA3_256, SHA3_384, SHA512 (..), hash, hashDigestSize)
 import qualified Crypto.KDF.HKDF as H
 import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+import qualified Crypto.PubKey.ECC.Types as ECC
 import qualified Crypto.PubKey.Ed25519 as Ed25519
 import qualified Crypto.PubKey.Ed448 as Ed448
 import Crypto.Random (ChaChaDRG, MonadPseudoRandom, drgNew, randomBytesGenerate, withDRG)
+import qualified Crypto.Store.PKCS8 as PK
 import Data.ASN1.BinaryEncoding
 import Data.ASN1.Encoding
 import Data.ASN1.Types
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
+import qualified Data.Binary as Bin
+import qualified Data.Bits as Bits
 import Data.ByteArray (ByteArrayAccess)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Base64 (decode, encode)
@@ -240,13 +245,14 @@ import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Lazy (fromStrict, toStrict)
+import qualified Data.ByteString.Lazy as LB
 import Data.Constraint (Dict (..))
 import Data.Kind (Constraint, Type)
 import qualified Data.List.NonEmpty as L
 import Data.String
 import Data.Type.Equality
 import Data.Typeable (Proxy (Proxy), Typeable)
-import Data.Word (Word32)
+import Data.Word (Word32, Word64)
 import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
 import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
@@ -256,12 +262,6 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll, parseString)
 import Simplex.Messaging.Util ((<$?>))
-import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
-import qualified Crypto.Store.PKCS8 as PK
-import qualified Crypto.PubKey.ECC.Types as ECC
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Binary as Bin
-import qualified Data.Bits as Bits
 
 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -1262,11 +1262,11 @@ instance SignatureAlgorithmX509 pk => SignatureAlgorithmX509 (a, pk) where
 -- | A wrapper to marshall signed ASN1 objects, like certificates.
 newtype SignedObject a = SignedObject {getSignedExact :: X.SignedExact a}
 
-instance (Typeable a, Eq a, Show a, ASN1Object a) => FromField (SignedObject a) where
+instance (Typeable a, Eq a, Show a, ASN1Object a) => FromField (SignedObject a)
 #if defined(dbPostgres)
-  fromField f dat = SignedObject <$> blobFieldDecoder X.decodeSignedObject f dat
+  where fromField f dat = SignedObject <$> blobFieldDecoder X.decodeSignedObject f dat
 #else
-  fromField = fmap SignedObject . blobFieldDecoder X.decodeSignedObject
+  where fromField = fmap SignedObject . blobFieldDecoder X.decodeSignedObject
 #endif
 
 instance (Eq a, Show a, ASN1Object a) => ToField (SignedObject a) where
@@ -1562,46 +1562,44 @@ readECPrivateKey f = do
 -- | Elliptic-Curve-Point-to-Octet-String Conversion without compression
 -- | as required by RFC8291
 -- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3
-uncompressEncodePoint :: ECC.Point -> BL.ByteString
+uncompressEncodePoint :: ECC.Point -> ByteString
 uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y
 uncompressEncodePoint ECC.PointO = "\0"
 
-uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point
+uncompressDecodePoint :: ByteString -> Either String ECC.Point
 uncompressDecodePoint "\0" = pure ECC.PointO
 uncompressDecodePoint s
-  | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported
-  | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid
+  | B.take 1 s /= prefix = Left "PointFormatUnsupported"
+  | B.length s /= 65 = Left "KeySizeInvalid"
   | otherwise = do
-    let s' = BL.drop 1 s
-    x <- decodeBigInt $ BL.take 32 s'
-    y <- decodeBigInt $ BL.drop 32 s'
-    pure $ ECC.Point x y
+      let s' = B.drop 1 s
+      x <- decodeBigInt $ B.take 32 s'
+      y <- decodeBigInt $ B.drop 32 s'
+      pure $ ECC.Point x y
   where
-    prefix = "\x04" :: BL.ByteString
+    prefix = "\x04" :: ByteString
 
 -- Used to test encryption against the RFC8291 Example - which gives the AS private key
-uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber
+uncompressDecodePrivateNumber :: ByteString -> Either String ECC.PrivateNumber
 uncompressDecodePrivateNumber s
-  | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid
-  | otherwise = do
-    decodeBigInt s
+  | B.length s /= 32 = Left "KeySizeInvalid"
+  | otherwise = decodeBigInt s
 
-encodeBigInt :: Integer -> BL.ByteString
-encodeBigInt i = do
+encodeBigInt :: Integer -> ByteString
+encodeBigInt i =
   let s1 = Bits.shiftR i 64
       s2 = Bits.shiftR s1 64
       s3 = Bits.shiftR s2 64
-  Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
+   in LB.toStrict $ Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
   where
-    w64 :: Integer -> Bin.Word64
+    w64 :: Integer -> Word64
     w64 = fromIntegral
 
-decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer
+decodeBigInt :: ByteString -> Either String Integer
 decodeBigInt s
-  | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid
-  | otherwise = do
-      let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 )
-      pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0
+  | B.length s /= 32 = Left "PointSizeInvalid"
+  | otherwise =
+      let (w3, w2, w1, w0) = Bin.decode (LB.fromStrict s) :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64)
+       in Right $ shift 3 w3 + shift 2 w2 + shift 1 w1 + fromIntegral w0
   where
     shift i w = Bits.shiftL (fromIntegral w) (64 * i)
-
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index dfc18013ef..e0ca4fc9e5 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -28,6 +28,7 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock.System
 import Data.Type.Equality
 import Data.Word (Word16)
+import Network.HTTP.Client (Request, parseUrlThrow)
 import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
 import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
@@ -36,11 +37,6 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Binary as Bin
-import qualified Crypto.Error as CE
-import qualified Data.Bits as Bits
-import Network.HTTP.Client (Request, parseUrlThrow)
 
 data NtfEntity = Token | Subscription
   deriving (Show)
@@ -487,11 +483,13 @@ data WPKey = WPKey
   }
   deriving (Eq, Ord, Show)
 
-uncompressEncode :: WPP256dh -> BL.ByteString
+uncompressEncode :: WPP256dh -> ByteString
 uncompressEncode (WPP256dh p) = C.uncompressEncodePoint p
+{-# INLINE uncompressEncode #-}
 
-uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh
+uncompressDecode :: ByteString -> Either String WPP256dh
 uncompressDecode bs = WPP256dh <$> C.uncompressDecodePoint bs
+{-# INLINE uncompressDecode #-}
 
 data WPTokenParams = WPTokenParams
   { wpPath :: ByteString,
@@ -508,18 +506,16 @@ instance StrEncoding WPAuth where
   strP = toWPAuth <$?> strP
 
 instance Encoding WPP256dh where
-  smpEncode p = smpEncode . BL.toStrict $ uncompressEncode p
-  smpP = smpP >>= \bs ->
-    case uncompressDecode (BL.fromStrict bs) of
-      Left _ -> fail "Invalid p256dh key"
-      Right res -> pure res
+  smpEncode = smpEncode . uncompressEncode
+  {-# INLINE smpEncode #-}
+  smpP = uncompressDecode <$?> smpP
+  {-# INLINE smpP #-}
 
 instance StrEncoding WPP256dh where
-  strEncode p = strEncode . BL.toStrict $ uncompressEncode p
-  strP = strP >>= \bs ->
-    case uncompressDecode (BL.fromStrict bs) of
-      Left _ -> fail "Invalid p256dh key"
-      Right res -> pure res
+  strEncode = strEncode . uncompressEncode
+  {-# INLINE strEncode #-}
+  strP = uncompressDecode <$?> strP
+  {-# INLINE strP #-}
 
 instance Encoding WPKey where
   smpEncode WPKey {wpAuth, wpP256dh} = smpEncode (wpAuth, wpP256dh)
@@ -594,12 +590,14 @@ instance ToJSON DeviceToken where
     APNSDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= decodeLatin1 t
     -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt
     WPDeviceToken p _ -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p)
-    -- WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t
+
+  -- WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t
   toJSON token = case token of
     APNSDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= decodeLatin1 t]
     -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt
     WPDeviceToken p _ -> J.object ["pushProvider" .= decodeLatin1 (strEncode p)]
-    -- WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t]
+
+-- WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t]
 
 instance FromJSON DeviceToken where
   parseJSON = J.withObject "DeviceToken" $ \o ->
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 1b3ad1230f..83f9994614 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -12,12 +12,15 @@ import Control.Concurrent (ThreadId)
 import Control.Logger.Simple
 import Control.Monad
 import Crypto.Random
+import Data.IORef (newIORef)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import qualified Data.X509.Validation as XV
+import Network.HTTP.Client (Manager, ManagerSettings (..), Request (..), newManager)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Network.Socket
 import qualified Network.TLS as TLS
 import Numeric.Natural
@@ -27,6 +30,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push
 import Simplex.Messaging.Notifications.Server.Push.APNS
+import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushClient (..), WebPushConfig, wpPushProviderClient)
 import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore)
 import Simplex.Messaging.Notifications.Server.Store.Postgres
@@ -46,10 +50,6 @@ import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, Transport
 import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
-import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient, WebPushConfig)
-import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager)
-import Network.HTTP.Client.TLS (tlsManagerSettings)
-import Data.IORef (newIORef)
 
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ASrvTransport, AddHTTP)],
@@ -185,16 +185,20 @@ newWPPushClient NtfPushServer {wpConfig, pushClients} pp = do
   -- We use one http manager per push server (which may be used by different clients)
   manager <- wpHTTPManager
   cache <- newIORef Nothing
-  pure $ wpPushProviderClient wpConfig cache manager
+  random <- C.newRandom
+  let client = WebPushClient {wpConfig, cache, manager, random}
+  pure $ wpPushProviderClient client
 
 wpHTTPManager :: IO Manager
-wpHTTPManager = newManager tlsManagerSettings {
-    -- Ideally, we should be able to override the domain resolution to
-    -- disable requests to non-public IPs. The risk is very limited as
-    -- we allow https only, and the body is encrypted. Disabling redirections
-    -- avoids cross-protocol redir (https => http/unix)
-    managerModifyRequest = \r -> pure r {redirectCount = 0}
-  }
+wpHTTPManager =
+  newManager
+    tlsManagerSettings
+      { -- Ideally, we should be able to override the domain resolution to
+        -- disable requests to non-public IPs. The risk is very limited as
+        -- we allow https only, and the body is encrypted. Disabling redirections
+        -- avoids cross-protocol redir (https => http/unix)
+        managerModifyRequest = \r -> pure r {redirectCount = 0}
+      }
 
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 getPushClient s@NtfPushServer {pushClients} pp =
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index fd54680ba9..db2279e643 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -262,7 +262,11 @@ ntfServerCLI cfgPath logPath =
                     persistErrorInterval = 0 -- seconds
                   },
               apnsConfig = defaultAPNSPushClientConfig,
-              wpConfig = WebPushConfig {vapidKey},
+              wpConfig =
+                WebPushConfig
+                  { vapidKey,
+                    paddedNtfLength = 3072
+                  },
               subsBatchSize = 900,
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 184d07a380..3de34cb9c5 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -4,131 +4,149 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
 {-# HLINT ignore "Use newtype instead of data" #-}
 
 module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
-import Network.HTTP.Client
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest, wpAud)
-import Simplex.Messaging.Notifications.Server.Store.Types
-import Simplex.Messaging.Notifications.Server.Push
-import Control.Monad.Except
+import Control.Exception (SomeException, fromException, try)
 import Control.Logger.Simple (logDebug)
-import Simplex.Messaging.Util (tshow)
-import qualified Data.ByteString as B
+import Control.Monad
+import Control.Monad.Except
 import Control.Monad.IO.Class (liftIO)
-import Control.Exception ( fromException, SomeException, try )
-import qualified Network.HTTP.Types as N
-import qualified Data.Aeson as J
-import Data.Aeson ((.=))
-import qualified Data.Binary as Bin
-import qualified Data.ByteArray as BA
-import qualified Data.ByteString.Lazy as BL
 import Control.Monad.Trans.Except (throwE)
-import Crypto.Hash.Algorithms (SHA256)
-import Crypto.Random (MonadRandom(getRandomBytes))
 import qualified Crypto.Cipher.Types as CT
+import Crypto.Hash.Algorithms (SHA256)
 import qualified Crypto.MAC.HMAC as HMAC
 import qualified Crypto.PubKey.ECC.DH as ECDH
-import qualified Crypto.PubKey.ECC.Types as ECC
 import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+import qualified Crypto.PubKey.ECC.Types as ECC
+import Crypto.Random (ChaChaDRG, getRandomBytes)
+import Data.Aeson ((.=))
+import qualified Data.Aeson as J
+import qualified Data.Binary as Bin
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.ByteString.Lazy as LB
 import Data.IORef
 import Data.Int (Int64)
-import Data.Time.Clock.System (systemSeconds, getSystemTime)
+import Data.Text (Text)
 import qualified Data.Text.Encoding as T
+import Data.Time.Clock.System (getSystemTime, systemSeconds)
+import Network.HTTP.Client
+import qualified Network.HTTP.Types as N
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfRegCode (..), WPAuth (..), WPKey (..), WPP256dh (..), WPTokenParams (..), encodePNMessages, wpAud, wpRequest)
+import Simplex.Messaging.Notifications.Server.Push
+import Simplex.Messaging.Notifications.Server.Store.Types
+import Simplex.Messaging.Util (liftError', safeDecodeUtf8, tshow)
+import UnliftIO.STM
 
 -- | Vapid
 -- | fp: fingerprint, base64url encoded without padding
 -- | key: privkey
 data VapidKey = VapidKey
-  { key::ECDSA.PrivateKey,
-    fp::B.ByteString
+  { key :: ECDSA.PrivateKey,
+    fp :: ByteString
   }
   deriving (Eq, Show)
 
 mkVapid :: ECDSA.PrivateKey -> VapidKey
-mkVapid key = VapidKey { key, fp }
+mkVapid key = VapidKey {key, fp}
   where
-    fp = B64.encodeUnpadded . BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key
+    fp = B64.encodeUnpadded $ C.uncompressEncodePoint $ ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ ECDSA.private_d key
+
+data WebPushClient = WebPushClient
+  { wpConfig :: WebPushConfig,
+    cache :: IORef (Maybe WPCache),
+    manager :: Manager,
+    random :: TVar ChaChaDRG
+  }
 
 data WebPushConfig = WebPushConfig
-  { vapidKey :: VapidKey
+  { vapidKey :: VapidKey,
+    paddedNtfLength :: Int
   }
 
 data WPCache = WPCache
-  { vapidHeader :: B.ByteString,
+  { vapidHeader :: ByteString,
     expire :: Int64
   }
 
-getVapidHeader :: VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString
+getVapidHeader :: VapidKey -> IORef (Maybe WPCache) -> ByteString -> IO ByteString
 getVapidHeader vapidK cache uriAuthority = do
   h <- readIORef cache
   now <- systemSeconds <$> getSystemTime
   case h of
     Nothing -> newCacheEntry now
     -- if it expires in 1 min, then we renew - for safety
-    Just entry -> if expire entry > now + 60 then pure $ vapidHeader entry
-      else newCacheEntry now
+    Just entry ->
+      if expire entry > now + 60
+        then pure $ vapidHeader entry
+        else newCacheEntry now
   where
-    newCacheEntry :: Int64 -> IO B.ByteString
+    newCacheEntry :: Int64 -> IO ByteString
     newCacheEntry now = do
       -- The new entry expires in one hour
       let expire = now + 3600
       vapidHeader <- mkVapidHeader vapidK uriAuthority expire
-      let entry = Just WPCache { vapidHeader, expire }
+      let entry = Just WPCache {vapidHeader, expire}
       atomicWriteIORef cache entry
       pure vapidHeader
 
 -- | With time in input for the tests
-getVapidHeader' :: Int64 -> VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString
+getVapidHeader' :: Int64 -> VapidKey -> IORef (Maybe WPCache) -> ByteString -> IO ByteString
 getVapidHeader' now vapidK cache uriAuthority = do
   h <- readIORef cache
   case h of
     Nothing -> newCacheEntry
-    Just entry -> if expire entry > now then pure $ vapidHeader entry
-      else newCacheEntry
+    Just entry ->
+      if expire entry > now
+        then pure $ vapidHeader entry
+        else newCacheEntry
   where
-    newCacheEntry :: IO B.ByteString
+    newCacheEntry :: IO ByteString
     newCacheEntry = do
       -- The new entry expires in one hour
       let expire = now + 3600
       vapidHeader <- mkVapidHeader vapidK uriAuthority expire
-      let entry = Just WPCache { vapidHeader, expire }
+      let entry = Just WPCache {vapidHeader, expire}
       atomicWriteIORef cache entry
       pure vapidHeader
 
 -- | mkVapidHeader -> vapid -> endpoint -> expire -> vapid header
-mkVapidHeader :: VapidKey -> B.ByteString -> Int64 -> IO B.ByteString
+mkVapidHeader :: VapidKey -> ByteString -> Int64 -> IO ByteString
 mkVapidHeader VapidKey {key, fp} uriAuthority expire = do
   let jwtHeader = mkJWTHeader "ES256" Nothing
-      jwtClaims = JWTClaims
-        { iss = Nothing,
-          iat = Nothing,
-          exp = Just expire,
-          aud = Just $ T.decodeUtf8 uriAuthority,
-          sub = Just "https://github.com/simplex-chat/simplexmq/"
-        }
+      jwtClaims =
+        JWTClaims
+          { iss = Nothing,
+            iat = Nothing,
+            exp = Just expire,
+            aud = Just $ T.decodeUtf8 uriAuthority,
+            sub = Just "https://github.com/simplex-chat/simplexmq/"
+          }
       jwt = JWTToken jwtHeader jwtClaims
   signedToken <- signedJWTToken key jwt
   pure $ "vapid t=" <> signedToken <> ",k=" <> fp
 
-wpPushProviderClient :: WebPushConfig -> IORef (Maybe WPCache) -> Manager -> PushProviderClient
-wpPushProviderClient _ _ _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
-wpPushProviderClient conf cache mg NtfTknRec {token = token@(WPDeviceToken pp param)} pn = do
+wpPushProviderClient :: WebPushClient -> PushProviderClient
+wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
+wpPushProviderClient c@WebPushClient {wpConfig, cache, manager} tkn@NtfTknRec {token = token@(WPDeviceToken pp params)} pn = do
   -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
   -- parsing will happen in DeviceToken parser, so it won't fail here
   r <- wpRequest token
-  vapidH <- liftPPWPError $ getVapidHeader (vapidKey conf) cache aud
-  logDebug $ "Request to " <> tshow (host r)
-  encBody <- body
+  vapidH <- liftError' toPPWPError $ try $ getVapidHeader (vapidKey wpConfig) cache $ wpAud pp
+  logDebug $ "Web Push request to " <> tshow (host r)
+  encBody <- withExceptT PPCryptoError $ wpEncrypt c tkn params pn
   let requestHeaders =
         [ ("TTL", "2592000"), -- 30 days
           ("Urgency", "high"),
           ("Content-Encoding", "aes128gcm"),
           ("Authorization", vapidH)
-    -- TODO: topic for pings and interval
+          -- TODO: topic for pings and interval
         ]
       req =
         r
@@ -137,77 +155,66 @@ wpPushProviderClient conf cache mg NtfTknRec {token = token@(WPDeviceToken pp pa
             requestBody = RequestBodyBS encBody,
             redirectCount = 0
           }
-  _ <- liftPPWPError $ httpNoBody req mg
-  pure ()
-  where
-    body :: ExceptT PushProviderError IO B.ByteString
-    body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn)
-    aud = wpAud pp
+  void $ liftError' toPPWPError $ try $ httpNoBody req manager
 
 -- | encrypt :: UA key -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
-wpEncrypt :: WPKey -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
-wpEncrypt wpKey clearT = do
-  salt :: B.ByteString <- liftIO $ getRandomBytes 16
+wpEncrypt :: WebPushClient -> NtfTknRec -> WPTokenParams -> PushNotification -> ExceptT C.CryptoError IO ByteString
+wpEncrypt WebPushClient {wpConfig, random} NtfTknRec {tknDhSecret} params pn = do
+  salt <- liftIO $ getRandomBytes 16
   asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1
-  wpEncrypt' wpKey asPrivK salt clearT
+  pn' <-
+    LB.toStrict . J.encode <$> case pn of
+      PNVerification (NtfRegCode code) -> do
+        (nonce, code') <- encrypt code
+        pure $ J.object ["nonce" .= nonce, "verification" .= code']
+      PNMessage msgData -> do
+        (nonce, msgData') <- encrypt $ encodePNMessages msgData
+        pure $ J.object ["nonce" .= nonce, "message" .= msgData']
+      PNCheckMessages -> pure $ J.object ["checkMessages" .= True]
+  wpEncrypt' (wpKey params) asPrivK salt pn'
+  where
+    encrypt :: ByteString -> ExceptT C.CryptoError IO (C.CbNonce, Text)
+    encrypt ntfData = do
+      nonce <- atomically $ C.randomCbNonce random
+      encData <- liftEither $ C.cbEncrypt tknDhSecret nonce ntfData $ paddedNtfLength wpConfig
+      pure (nonce, safeDecodeUtf8 $ B64.encode encData)
 
 -- | encrypt :: UA key -> AS key -> salt -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
-wpEncrypt' :: WPKey -> ECC.PrivateNumber -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
+wpEncrypt' :: WPKey -> ECC.PrivateNumber -> ByteString -> ByteString -> ExceptT C.CryptoError IO ByteString
 wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do
-  let uaPubKS = BL.toStrict . C.uncompressEncodePoint $ uaPubK
-  let asPubKS = BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
+  let uaPubKS = C.uncompressEncodePoint uaPubK
+  let asPubKS = C.uncompressEncodePoint $ ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) asPrivK
       ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK
       prkKey = hmac (unWPAuth wpAuth) ecdhSecret
       keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS
       ikm = hmac prkKey (keyInfo <> "\x01")
       prk = hmac salt ikm
-      cekInfo = "Content-Encoding: aes128gcm\0" :: B.ByteString
-      cek = takeHM 16 $ hmac prk (cekInfo <> "\x01")
-      nonceInfo = "Content-Encoding: nonce\0" :: B.ByteString
-      nonce = takeHM 12 $ hmac prk (nonceInfo <> "\x01")
-      rs = BL.toStrict $ Bin.encode (4096 :: Bin.Word32) -- with RFC8291, it's ok to always use 4096 because there is only one single record and the final record can be smaller than rs (RFC8188)
-      idlen = BL.toStrict $ Bin.encode (65 :: Bin.Word8) -- with RFC8291, keyid is the pubkey, so always 65 bytes
+      cekInfo = "Content-Encoding: aes128gcm\0" :: ByteString
+      cek = B.take 16 $ BA.convert $ hmac prk (cekInfo <> "\x01")
+      nonceInfo = "Content-Encoding: nonce\0" :: ByteString
+      nonce = B.take 12 $ BA.convert $ hmac prk (nonceInfo <> "\x01")
+      rs = LB.toStrict $ Bin.encode (4096 :: Bin.Word32) -- with RFC8291, it's ok to always use 4096 because there is only one single record and the final record can be smaller than rs (RFC8188)
+      idlen = LB.toStrict $ Bin.encode (65 :: Bin.Word8) -- with RFC8291, keyid is the pubkey, so always 65 bytes
       header = salt <> rs <> idlen <> asPubKS
-  iv <- ivFrom nonce
+  iv <- liftEither $ C.gcmIV nonce
   -- The last record uses a padding delimiter octet set to the value 0x02
   (C.AuthTag (CT.AuthTag tag), cipherT) <- C.encryptAES128NoPad (C.Key cek) iv $ clearT <> "\x02"
   -- Uncomment to see intermediate values, to compare with RFC8291 example
-  -- liftIO . print $ strEncode (BA.convert ecdhSecret :: B.ByteString)
-  -- liftIO . print . strEncode $ takeHM 32 prkKey
+  -- liftIO . print $ strEncode (BA.convert ecdhSecret :: ByteString)
+  -- liftIO . print . strEncode $ B.take 32 $ BA.convert prkKey
   -- liftIO . print $ strEncode cek
   -- liftIO . print $ strEncode cipherT
   pure $ header <> cipherT <> BA.convert tag
   where
     hmac k v = HMAC.hmac k v :: HMAC.HMAC SHA256
-    takeHM :: Int -> HMAC.HMAC SHA256 -> B.ByteString
-    takeHM n v = BL.toStrict $ BL.pack $ take n $ BA.unpack v
-    ivFrom :: B.ByteString -> ExceptT C.CryptoError IO C.GCMIV
-    ivFrom s = case C.gcmIV s of
-      Left e -> throwE e
-      Right iv -> pure iv
-
-encodeWPN :: PushNotification -> BL.ByteString
-encodeWPN pn = J.encode $ case pn of
-  PNVerification code -> J.object ["verification" .= code]
-  -- This hack prevents sending unencrypted message metadata in notifications, as we do not use it in the client - it simply receives all messages on each notification.
-  -- If we decide to change it to pull model as used in iOS, we can change JSON key to "message" with any payload, as the current clients would interpret it as "checkMessages".
-  -- In this case an additional encryption layer would need to be added here, in the same way as with APNS notifications.
-  PNMessage _ -> J.object ["checkMessages" .= True]
-  PNCheckMessages -> J.object ["checkMessages" .= True]
-
-liftPPWPError :: IO a -> ExceptT PushProviderError IO a
-liftPPWPError = liftPPWPError' toPPWPError
-
-liftPPWPError' :: (SomeException -> PushProviderError) -> IO a -> ExceptT PushProviderError IO a
-liftPPWPError' err a = liftIO (try @SomeException a) >>= either (throwError . err) return
 
 toPPWPError :: SomeException -> PushProviderError
 toPPWPError e = case fromException e of
-    Just (InvalidUrlException _ _) -> PPWPInvalidUrl
-    Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (responseStatus resp) ("" :: String)
-    _ -> PPWPOtherError e
+  Just (InvalidUrlException _ _) -> PPWPInvalidUrl
+  Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (responseStatus resp) ("" :: String)
+  _ -> PPWPOtherError e
   where
     fromStatusCode status reason
       | status == N.status200 = PPWPRemovedEndpoint
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index 275d0bab0a..cb59b3ec6d 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -16,6 +16,7 @@
 module NtfClient where
 
 import Control.Concurrent.STM (retry)
+import Control.Exception (throwIO)
 import Control.Monad
 import Control.Monad.Except (runExceptT)
 import Control.Monad.IO.Class
@@ -44,8 +45,10 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
+import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
 import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
+import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig (..))
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
@@ -60,9 +63,6 @@ import UnliftIO.Async
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
-import Control.Exception (throwIO)
-import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig(..))
-import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
 
 testHost :: NonEmpty TransportHost
 testHost = "localhost"
@@ -130,43 +130,45 @@ testNtfClient client = do
 ntfServerCfg :: IO NtfServerConfig
 ntfServerCfg = do
   vapidKey <- getVapidKey "tests/fixtures/vapid.privkey"
-  pure NtfServerConfig
-    { transports = [],
-      controlPort = Nothing,
-      controlPortUserAuth = Nothing,
-      controlPortAdminAuth = Nothing,
-      subIdBytes = 24,
-      regCodeBytes = 32,
-      clientQSize = 2,
-      pushQSize = 2,
-      smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
-      apnsConfig =
-        defaultAPNSPushClientConfig
-          { apnsPort = apnsTestPort,
-            caStoreFile = "tests/fixtures/ca.crt"
-          },
-      wpConfig = WebPushConfig {vapidKey},
-      subsBatchSize = 900,
-      inactiveClientExpiration = Just defaultInactiveClientExpiration,
-      dbStoreConfig = ntfTestDBCfg,
-      ntfCredentials = ntfTestServerCredentials,
-      useServiceCreds = True,
-      periodicNtfsInterval = 1,
-      -- stats config
-      logStatsInterval = Nothing,
-      logStatsStartTime = 0,
-      serverStatsLogFile = "tests/ntf-server-stats.daily.log",
-      serverStatsBackupFile = Nothing,
-      prometheusInterval = Nothing,
-      prometheusMetricsFile = ntfTestPrometheusMetricsFile,
-      ntfServerVRange = supportedServerNTFVRange,
-      transportConfig = mkTransportServerConfig True (Just alpnSupportedNTFHandshakes) False,
-      startOptions = defaultStartOptions
-    }
+  pure
+    NtfServerConfig
+      { transports = [],
+        controlPort = Nothing,
+        controlPortUserAuth = Nothing,
+        controlPortAdminAuth = Nothing,
+        subIdBytes = 24,
+        regCodeBytes = 32,
+        clientQSize = 2,
+        pushQSize = 2,
+        smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
+        apnsConfig =
+          defaultAPNSPushClientConfig
+            { apnsPort = apnsTestPort,
+              caStoreFile = "tests/fixtures/ca.crt"
+            },
+        wpConfig = WebPushConfig {vapidKey, paddedNtfLength = 3072},
+        subsBatchSize = 900,
+        inactiveClientExpiration = Just defaultInactiveClientExpiration,
+        dbStoreConfig = ntfTestDBCfg,
+        ntfCredentials = ntfTestServerCredentials,
+        useServiceCreds = True,
+        periodicNtfsInterval = 1,
+        -- stats config
+        logStatsInterval = Nothing,
+        logStatsStartTime = 0,
+        serverStatsLogFile = "tests/ntf-server-stats.daily.log",
+        serverStatsBackupFile = Nothing,
+        prometheusInterval = Nothing,
+        prometheusMetricsFile = ntfTestPrometheusMetricsFile,
+        ntfServerVRange = supportedServerNTFVRange,
+        transportConfig = mkTransportServerConfig True (Just alpnSupportedNTFHandshakes) False,
+        startOptions = defaultStartOptions
+      }
 
 ntfServerCfgVPrev :: IO NtfServerConfig
-ntfServerCfgVPrev = ntfServerCfg >>=
-  \cfg -> pure $ ntfServerCfgVPrev' cfg
+ntfServerCfgVPrev =
+  ntfServerCfg
+    >>= \cfg -> pure $ ntfServerCfgVPrev' cfg
 
 ntfServerCfgVPrev' :: NtfServerConfig -> NtfServerConfig
 ntfServerCfgVPrev' cfg =
@@ -180,8 +182,9 @@ ntfServerCfgVPrev' cfg =
     serverVRange' = serverVRange smpCfg'
 
 withNtfServerThreadOn :: HasCallStack => ASrvTransport -> ServiceName -> PostgresStoreCfg -> (HasCallStack => ThreadId -> IO a) -> IO a
-withNtfServerThreadOn t port' dbStoreConfig a = ntfServerCfg >>= \cfg ->
-  withNtfServerCfg cfg {transports = [(port', t, False)], dbStoreConfig} a
+withNtfServerThreadOn t port' dbStoreConfig a =
+  ntfServerCfg >>= \cfg ->
+    withNtfServerCfg cfg {transports = [(port', t, False)], dbStoreConfig} a
 
 withNtfServerCfg :: HasCallStack => NtfServerConfig -> (ThreadId -> IO a) -> IO a
 withNtfServerCfg cfg@NtfServerConfig {transports} =
diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index b884c964be..1323eafa1a 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -1,33 +1,29 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DataKinds #-}
 
 module NtfWPTests where
 
-import Test.Hspec hiding (fit, it)
-import Util
-import Simplex.Messaging.Encoding.String (StrEncoding(..))
-import qualified Data.ByteString as B
-import qualified Crypto.PubKey.ECC.Types as ECC
-import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN, getVapidHeader')
+import Control.Monad (unless)
 import Control.Monad.Except (runExceptT)
-import qualified Data.ByteString.Lazy as BL
-import Simplex.Messaging.Notifications.Server.Push
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import qualified Simplex.Messaging.Crypto as C
-import Data.Time.Clock.System (SystemTime(..))
+import qualified Crypto.PubKey.ECC.Types as ECC
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
 import Data.Either (isLeft)
 import Data.IORef (newIORef)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
-import Control.Monad (unless)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (getVapidHeader', wpEncrypt')
+import Test.Hspec hiding (fit, it)
+import Util
 
 ntfWPTests :: Spec
 ntfWPTests = describe "NTF Protocol" $ do
   it "decode WPDeviceToken from string" testWPDeviceTokenStrEncoding
   it "decode invalid WPDeviceToken" testInvalidWPDeviceTokenStrEncoding
   it "Encrypt RFC8291 example" testWPEncryption
-  it "PushNotifications encoding" testPNEncoding
   it "Vapid header cache" testVapidCache
 
 testWPDeviceTokenStrEncoding :: Expectation
@@ -38,7 +34,7 @@ testWPDeviceTokenStrEncoding = do
 
   let auth = either error id $ strDecode "AQ3VfRX3_F38J3ltcmMVRg"
   let pk = either error id $ strDecode "BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
-  let params ::WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  let params :: WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
   wpPath params `shouldBe` "/secret"
   let key = wpKey params
   wpAuth key `shouldBe` auth
@@ -59,16 +55,16 @@ testInvalidWPDeviceTokenStrEncoding = do
   -- e.g "https://#1" is a valid URL. But that is the same parser
   -- we use to send the requests, so that's fine.
   let ts = "webpush https://localhost:/ AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
-  let t = strDecode ts :: Either String DeviceToken
+      t = strDecode ts :: Either String DeviceToken
   t `shouldSatisfy` isLeft
 
 -- | Example from RFC8291
 testWPEncryption :: Expectation
 testWPEncryption = do
-  let clearT :: B.ByteString = "When I grow up, I want to be a watermelon"
-  let pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4"
-  let salt :: B.ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw"
-  let privBS :: BL.ByteString = either error BL.fromStrict $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw"
+  let clearT :: ByteString = "When I grow up, I want to be a watermelon"
+      pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4"
+      salt :: ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw"
+      privBS :: ByteString = either error id $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw"
   asPriv :: ECC.PrivateNumber <- case C.uncompressDecodePrivateNumber privBS of
     Left e -> fail $ "Cannot decode PrivateNumber from b64 " <> show e
     Right p -> pure p
@@ -78,22 +74,6 @@ testWPEncryption = do
     Right c -> pure c
   strEncode cipher `shouldBe` "DGv6ra1nlYgDCS1FRnbzlwAAEABBBP4z9KsN6nGRTbVYI_c7VJSPQTBtkgcy27mlmlMoZIIgDll6e3vCYLocInmYWAmS6TlzAC8wEqKK6PBru3jl7A_yl95bQpu6cVPTpK4Mqgkf1CXztLVBSt2Ks3oZwbuwXPXLWyouBWLVWGNWQexSgSxsj_Qulcy4a-fN"
 
-testPNEncoding :: Expectation
-testPNEncoding = do
-  let pnVerif = PNVerification (NtfRegCode "abcd")
-      pnCheck = PNCheckMessages
-      pnMess = pnM "MyMessage"
-  enc pnCheck `shouldBe` "{\"checkMessages\":true}"
-  enc pnVerif `shouldBe` "{\"verification\":\"YWJjZA==\"}"
-  enc pnMess `shouldBe` "{\"checkMessages\":true}"
-  where
-    enc p = BL.toStrict $ encodeWPN p
-    pnM :: B.ByteString -> PushNotification
-    pnM m = do
-      let smpQ = either error id $ strDecode "smp://AAAA@l/AAAA"
-      let now = MkSystemTime 1761827386 0
-      PNMessage $ PNMessageData smpQ now (C.cbNonce "nonce") m :| []
-
 testVapidCache :: Expectation
 testVapidCache = do
   let wpaud = "https://localhost"
@@ -111,11 +91,11 @@ testVapidCache = do
   v3 `shouldContainBS` "vapid t=eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9."
   v3 `shouldContainBS` ",k=BIk7ASkEr1A1rJRGXMKi77tAGj3dRouSgZdW6S5pee7a3h7fkvd0OYQixy4yj35UFZt8hd9TwAQiybDK_HJLwJA"
 
-shouldContainBS :: B.ByteString -> B.ByteString -> Expectation
+shouldContainBS :: ByteString -> ByteString -> Expectation
 shouldContainBS actual expected =
   unless (expected `B.isInfixOf` actual) $
     expectationFailure $
-      "Expected ByteString to contain:\n" ++
-      show expected ++
-      "\nBut got:\n" ++
-      show actual
+      "Expected ByteString to contain:\n"
+        ++ show expected
+        ++ "\nBut got:\n"
+        ++ show actual

From ea9adf1ac591b5437aee702383daff1c41ff89e3 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 19 Jan 2026 21:05:28 +0000
Subject: [PATCH 26/26] webpush: small fixes (#1699)

* Fix compilation for client lib

* Print VAPID fp

* Fix VAPID signature

* refactor

---------

Co-authored-by: sim <git@sgougeon.fr>
---
 simplexmq.cabal                               |  2 +-
 src/Simplex/Messaging/Crypto.hs               |  1 +
 .../Messaging/Notifications/Server/Main.hs    | 26 ++++++-----
 .../Messaging/Notifications/Server/Push.hs    | 45 +++++++++++--------
 .../Notifications/Server/Push/WebPush.hs      |  4 +-
 5 files changed, 46 insertions(+), 32 deletions(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 57ceaa5991..d72d3f02c0 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -312,6 +312,7 @@ library
     , directory ==1.3.*
     , filepath ==1.4.*
     , hourglass ==0.2.*
+    , http-client ==0.7.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
     , iproute ==1.7.*
@@ -343,7 +344,6 @@ library
         case-insensitive ==1.2.*
       , hashable ==1.4.*
       , ini ==0.4.1
-      , http-client ==0.7.*
       , http-client-tls ==0.3.6.*
       , optparse-applicative >=0.15 && <0.17
       , process ==1.6.*
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 05c6b32e9b..bf2a4ac3b5 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -95,6 +95,7 @@ module Simplex.Messaging.Crypto
     encodePrivKey,
     decodePrivKey,
     pubKeyBytes,
+    encodeBigInt,
     uncompressEncodePoint,
     uncompressDecodePoint,
     uncompressDecodePrivateNumber,
diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index db2279e643..d2c2d393bc 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -11,7 +11,7 @@
 module Simplex.Messaging.Notifications.Server.Main where
 
 import Control.Logger.Simple (setLogLevel)
-import Control.Monad ( (<$!>), unless, void )
+import Control.Monad (unless, void, (<$!>))
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
@@ -31,9 +31,10 @@ import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClie
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol (NtfTokenId)
-import Simplex.Messaging.Notifications.Server (runNtfServer, restoreServerLastNtfs)
+import Simplex.Messaging.Notifications.Server (restoreServerLastNtfs, runNtfServer)
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..), defaultInactiveClientExpiration)
 import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (VapidKey (..), WebPushConfig (..), mkVapid)
 import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore)
 import Simplex.Messaging.Notifications.Server.Store.Postgres (exportNtfDbStore, importNtfSTMStore, newNtfDbStore)
 import Simplex.Messaging.Notifications.Server.StoreLog (readWriteNtfSTMStore)
@@ -55,9 +56,8 @@ import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
-import Text.Read (readMaybe)
 import System.Process (readCreateProcess, shell)
-import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig(..), VapidKey, mkVapid)
+import Text.Read (readMaybe)
 
 ntfServerCLI :: FilePath -> FilePath -> IO ()
 ntfServerCLI cfgPath logPath =
@@ -215,12 +215,13 @@ ntfServerCLI cfgPath logPath =
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
       fp <- checkSavedFingerprint cfgPath defaultX509Config
-      vapidKey <- getVapidKey vapidKeyPath
+      vapidKey@VapidKey {fp = vapidFp} <- getVapidKey vapidKeyPath
       let host = either (const "<hostnames>") T.unpack $ lookupValue "TRANSPORT" "host" ini
           port = T.unpack $ strictIni "TRANSPORT" "port" ini
           cfg@NtfServerConfig {transports} = serverConfig vapidKey
           srv = ProtoServerWithAuth (NtfServer [THDomainName host] (if port == "443" then "" else port) (C.KeyHash fp)) Nothing
       printServiceInfo serverVersion srv
+      B.putStrLn $ "VAPID: " <> vapidFp
       printNtfServerConfig transports dbStoreConfig
       runNtfServer cfg
       where
@@ -360,18 +361,21 @@ cliCommandP cfgPath logPath iniFile =
     skipTokensP =
       option
         strParse
-          ( long "skip-tokens"
-              <> help "Skip tokens during import"
-              <> value S.empty
-          )
+        ( long "skip-tokens"
+            <> help "Skip tokens during import"
+            <> value S.empty
+        )
     initP :: Parser InitOptions
     initP = do
       enableStoreLog <-
-        flag' False
+        flag'
+          False
           ( long "disable-store-log"
               <> help "Disable store log for persistence (enabled by default)"
           )
-          <|> flag True True
+          <|> flag
+            True
+            True
             ( long "store-log"
                 <> short 'l'
                 <> help "Enable store log for persistence (DEPRECATED, enabled by default)"
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index 1039e54484..ff21de2d4a 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -10,6 +10,8 @@
 
 module Simplex.Messaging.Notifications.Server.Push where
 
+import Control.Exception (Exception)
+import Control.Monad.Except (ExceptT)
 import Crypto.Hash.Algorithms (SHA256 (..))
 import qualified Crypto.PubKey.ECC.ECDSA as EC
 import qualified Crypto.PubKey.ECC.Types as ECT
@@ -28,15 +30,13 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text (Text)
 import Data.Time.Clock.System
 import qualified Data.X509 as X
+import GHC.Exception (SomeException)
+import Network.HTTP.Types (Status)
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Server.Store.Types (NtfTknRec)
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError)
-import qualified Simplex.Messaging.Crypto as C
-import Network.HTTP.Types (Status)
-import Control.Exception (Exception)
-import Simplex.Messaging.Notifications.Server.Store.Types (NtfTknRec)
-import Control.Monad.Except (ExceptT)
-import GHC.Exception (SomeException)
 
 data JWTHeader = JWTHeader
   { typ :: Text, -- "JWT"
@@ -46,7 +46,7 @@ data JWTHeader = JWTHeader
   deriving (Show)
 
 mkJWTHeader :: Text -> Maybe Text -> JWTHeader
-mkJWTHeader alg kid = JWTHeader { typ = "JWT", alg, kid }
+mkJWTHeader alg kid = JWTHeader {typ = "JWT", alg, kid}
 
 data JWTClaims = JWTClaims
   { iss :: Maybe Text, -- issuer, team ID for APNS
@@ -65,13 +65,14 @@ mkJWTToken hdr iss = do
   iat <- systemSeconds <$> getSystemTime
   pure $ JWTToken hdr $ jwtClaims iat
   where
-    jwtClaims iat = JWTClaims
-      { iss = Just iss,
-        iat = Just iat,
-        exp = Nothing,
-        aud = Nothing,
-        sub = Nothing
-      }
+    jwtClaims iat =
+      JWTClaims
+        { iss = Just iss,
+          iat = Just iat,
+          exp = Nothing,
+          aud = Nothing,
+          sub = Nothing
+        }
 
 type SignedJWTToken = ByteString
 
@@ -79,15 +80,23 @@ $(JQ.deriveToJSON defaultJSON ''JWTHeader)
 
 $(JQ.deriveToJSON defaultJSON ''JWTClaims)
 
-signedJWTToken :: EC.PrivateKey -> JWTToken -> IO SignedJWTToken
-signedJWTToken pk (JWTToken hdr claims) = do
+signedJWTToken_ :: (EC.Signature -> ByteString) -> EC.PrivateKey -> JWTToken -> IO SignedJWTToken
+signedJWTToken_ serialize pk (JWTToken hdr claims) = do
   let hc = jwtEncode hdr <> "." <> jwtEncode claims
   sig <- EC.sign pk SHA256 hc
-  pure $ hc <> "." <> serialize sig
+  pure $ hc <> "." <> U.encodeUnpadded (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]
+
+signedJWTToken :: EC.PrivateKey -> JWTToken -> IO SignedJWTToken
+signedJWTToken = signedJWTToken_ $ \sig ->
+  encodeASN1' DER [Start Sequence, IntVal (EC.sign_r sig), IntVal (EC.sign_s sig), End Sequence]
+
+-- | Does it work with APNS ?
+signedJWTTokenRaw :: EC.PrivateKey -> JWTToken -> IO SignedJWTToken
+signedJWTTokenRaw = signedJWTToken_ $ \sig ->
+  C.encodeBigInt (EC.sign_r sig) <> C.encodeBigInt (EC.sign_s sig)
 
 readECPrivateKey :: FilePath -> IO EC.PrivateKey
 readECPrivateKey f = do
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 3de34cb9c5..d6a656d864 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -125,11 +125,11 @@ mkVapidHeader VapidKey {key, fp} uriAuthority expire = do
           { iss = Nothing,
             iat = Nothing,
             exp = Just expire,
-            aud = Just $ T.decodeUtf8 uriAuthority,
+            aud = Just $ T.decodeUtf8 $ "https://" <> uriAuthority,
             sub = Just "https://github.com/simplex-chat/simplexmq/"
           }
       jwt = JWTToken jwtHeader jwtClaims
-  signedToken <- signedJWTToken key jwt
+  signedToken <- signedJWTTokenRaw key jwt
   pure $ "vapid t=" <> signedToken <> ",k=" <> fp
 
 wpPushProviderClient :: WebPushClient -> PushProviderClient