From 3a266cc4d9fcd5b35edbc42cce1a2b3ea18ea636 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 24 Oct 2025 11:57:14 +0200
Subject: [PATCH 01/23] Parse WPDeviceToken during registration

---
 simplexmq.cabal                               |   1 +
 src/Simplex/Messaging/Agent.hs                |   2 +
 .../Messaging/Notifications/Protocol.hs       | 228 +++++++++++++++---
 .../Messaging/Notifications/Server/Env.hs     |  14 +-
 .../Notifications/Server/Push/WebPush.hs      |  85 ++-----
 tests/NtfProtocolTests.hs                     |  44 ++++
 tests/Test.hs                                 |   2 +
 7 files changed, 271 insertions(+), 105 deletions(-)
 create mode 100644 tests/NtfProtocolTests.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 1ff387862..206a28b50 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -483,6 +483,7 @@ test-suite simplexmq-test
       CoreTests.UtilTests
       CoreTests.VersionRangeTests
       FileDescriptionTests
+      NtfProtocolTests
       RemoteControl
       ServerTests
       SMPAgentClient
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 27967bfd6..28be3c63a 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -551,6 +551,8 @@ testProtocolServer c nm userId srv = withAgentEnv' c $ case protocolTypeI @p of
   SPSMP -> runSMPServerTest c nm userId srv
   SPXFTP -> runXFTPServerTest c nm userId srv
   SPNTF -> runNTFServerTest c nm userId srv
+  -- TODO
+  SPHTTPS -> pure Nothing
 
 -- | set SOCKS5 proxy on/off and optionally set TCP timeouts for fast network
 setNetworkConfig :: AgentClient -> NetworkConfig -> IO ()
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 1b074be43..b5a9f4675 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -18,8 +18,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 (..))
@@ -28,7 +28,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 +37,10 @@ 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
 
 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
@@ -441,25 +445,170 @@ instance StrEncoding WPProvider where
   strEncode (WPP srv) = "webpush " <> strEncode srv
   strP = WPP <$> ("webpush " *> strP)
 
-instance FromField APNSProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+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)
+
+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)
 
-instance ToField APNSProvider where toField = toField . decodeLatin1 . strEncode
+-- | 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
+
+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 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
+  { wpPath :: B.ByteString,
+    wpKey :: WPKey
   }
-
-newtype WPKey =  WPKey ECC.Point
+  deriving (Eq, Ord, Show)
 
 data WPEndpoint = WPEndpoint
-  { endpoint :: ByteString,
-    auth :: ByteString,
-    p256dh :: ByteString
+  { endpoint :: B.ByteString,
+    auth :: B.ByteString,
+    p256dh :: B.ByteString
   }
   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 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
+    wpAuth <- smpP
+    wpP256dh <- smpP
+    pure WPKey {wpAuth, wpP256dh}
+
+instance StrEncoding WPKey where
+  strEncode WPKey {wpAuth, wpP256dh} = strEncode (wpAuth, wpP256dh)
+  strP = do
+    (wpAuth, wpP256dh) <- strP
+    pure WPKey {wpAuth, wpP256dh}
+
 instance Encoding WPEndpoint where
   smpEncode WPEndpoint {endpoint, auth, p256dh} = smpEncode (endpoint, auth, p256dh)
   smpP = do
@@ -468,6 +617,21 @@ instance Encoding WPEndpoint where
     p256dh <- smpP
     pure WPEndpoint {endpoint, auth, p256dh}
 
+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 ' '
+    wpKey <- strP
+    pure WPTokenParams {wpPath, wpKey}
+
 instance StrEncoding WPEndpoint where
   strEncode WPEndpoint {endpoint, auth, p256dh} = endpoint <> " " <> strEncode auth <> " " <> strEncode p256dh
   strP = do
@@ -495,10 +659,8 @@ instance FromJSON WPEndpoint where
     pure WPEndpoint {endpoint, auth, p256dh}
 
 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,42 +675,48 @@ 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 =
+      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
@@ -556,7 +724,7 @@ deviceToken' pp t = case pp of
 -- 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 +769,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 a4b2fca6e..afdfc18ba 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -165,23 +165,23 @@ 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
   let c = wpPushProviderClient manager
-  atomically $ TM.insert PPWebPush c pushClients
+  atomically $ TM.insert (PPWP pp) c pushClients
   pure c
 
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index be681b034..0929c26c8 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 (..), WPProvider (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint)
 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,20 @@ 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)
+import Simplex.Messaging.Encoding.String (StrEncoding(..))
 
 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 = WPDeviceToken (WPP s) 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
+  -- parsing will happen in DeviceToken parser, so it won't fail here
+  let endpoint = strEncode s <> wpPath param
   r <- liftPPWPError $ parseUrlThrow $ B.unpack endpoint
   logDebug $ "Request to " <> tshow (host r)
-  encBody <- body wpe
+  encBody <- body
   let requestHeaders =
         [ ("TTL", "2592000"), -- 30 days
           ("Urgency", "high"),
@@ -66,27 +62,21 @@ 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
 -- | 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 {wpAuth, wpP256dh = WPP256dh uaPubK} 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
+  --let uaPubK = wpP256dh key
+  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 +85,13 @@ 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"
   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 = strEncode 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 +100,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/tests/NtfProtocolTests.hs b/tests/NtfProtocolTests.hs
new file mode 100644
index 000000000..0e10f1d86
--- /dev/null
+++ b/tests/NtfProtocolTests.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+
+module NtfProtocolTests where
+
+import Test.Hspec hiding (fit, it)
+import Util
+import Simplex.Messaging.Encoding.String (StrEncoding(..))
+import Simplex.Messaging.Notifications.Protocol
+    ( DeviceToken(WPDeviceToken),
+      WPTokenParams(..),
+      WPKey(..),
+      WPProvider(WPP) )
+import Simplex.Messaging.Protocol (ProtocolServer, ProtocolType(..))
+
+ntfProtocolTests :: Spec
+ntfProtocolTests = describe "NTF Protocol" $ do
+  it "decode WPDeviceToken from string" testWPDeviceTokenStrEncoding
+
+testWPDeviceTokenStrEncoding :: Expectation
+testWPDeviceTokenStrEncoding = do
+  -- TODO: Web Push endpoint should not require a keyHash
+  -- let ts = "webpush https://localhost/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  let ts = "webpush https://AAAA@localhost:8000/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://AAAA@localhost:8000"
+
+  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://AAAA@localhost:8000/secret"
diff --git a/tests/Test.hs b/tests/Test.hs
index 364080e0c..a87e60c0b 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -40,6 +40,7 @@ import XFTPServerTests (xftpServerTests)
 import Fixtures
 #else
 import AgentTests.SchemaDump (schemaDumpTest)
+import NtfProtocolTests (ntfProtocolTests)
 #endif
 
 #if defined(dbServerPostgres)
@@ -150,6 +151,7 @@ main = do
           describe "XFTP agent" xftpAgentTests
         describe "XRCP" remoteControlTests
         describe "Server CLIs" cliTests
+        describe "NTFProtocol" ntfProtocolTests
 
 eventuallyRemove :: FilePath -> Int -> IO ()
 eventuallyRemove path retries = case retries of

From 8aa5d1c29d0dce330bcf47b1269d85fbeb69dbca Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Tue, 28 Oct 2025 09:28:39 +0100
Subject: [PATCH 02/23] Clarify PPInvalidPusher with apnsPushProviderClient

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

diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index ebe223830..24652c81e 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 =

From 653127f01d86d31a1e45bb17e2c877f2b07a90fa Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Tue, 28 Oct 2025 14:20:23 +0100
Subject: [PATCH 03/23] Use SrvLoc for webpush endpoints

---
 src/Simplex/Messaging/Agent.hs                  |  2 --
 src/Simplex/Messaging/Notifications/Protocol.hs | 13 ++++++++++++-
 src/Simplex/Messaging/Protocol.hs               | 10 +---------
 src/Simplex/Messaging/ServiceScheme.hs          |  7 +++++++
 tests/NtfProtocolTests.hs                       |  9 +++------
 5 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 28be3c63a..27967bfd6 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -551,8 +551,6 @@ testProtocolServer c nm userId srv = withAgentEnv' c $ case protocolTypeI @p of
   SPSMP -> runSMPServerTest c nm userId srv
   SPXFTP -> runXFTPServerTest c nm userId srv
   SPNTF -> runNTFServerTest c nm userId srv
-  -- TODO
-  SPHTTPS -> pure Nothing
 
 -- | set SOCKS5 proxy on/off and optionally set TCP timeouts for fast network
 setNetworkConfig :: AgentClient -> NetworkConfig -> IO ()
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index b5a9f4675..119b14107 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -388,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
@@ -437,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)
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 7249ac1d2..40314ad2a 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 | PHTTPS
+data ProtocolType = PSMP | PNTF | PXFTP
   deriving (Eq, Ord, Show)
 
 instance StrEncoding ProtocolType where
@@ -1152,20 +1152,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)
 
@@ -1184,7 +1181,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
@@ -1192,14 +1188,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
@@ -1237,8 +1231,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 3cd828aa7..1f9fe22e1 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/NtfProtocolTests.hs b/tests/NtfProtocolTests.hs
index 0e10f1d86..d20a92807 100644
--- a/tests/NtfProtocolTests.hs
+++ b/tests/NtfProtocolTests.hs
@@ -12,7 +12,6 @@ import Simplex.Messaging.Notifications.Protocol
       WPTokenParams(..),
       WPKey(..),
       WPProvider(WPP) )
-import Simplex.Messaging.Protocol (ProtocolServer, ProtocolType(..))
 
 ntfProtocolTests :: Spec
 ntfProtocolTests = describe "NTF Protocol" $ do
@@ -20,9 +19,7 @@ ntfProtocolTests = describe "NTF Protocol" $ do
 
 testWPDeviceTokenStrEncoding :: Expectation
 testWPDeviceTokenStrEncoding = do
-  -- TODO: Web Push endpoint should not require a keyHash
-  -- let ts = "webpush https://localhost/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
-  let ts = "webpush https://AAAA@localhost:8000/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  let ts = "webpush https://localhost/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
   -- let ts = "apns_null test_ntf_token"
   -- let ts = "apns_test 11111111222222223333333344444444"
 
@@ -34,11 +31,11 @@ testWPDeviceTokenStrEncoding = do
   wpAuth key `shouldBe` auth
   wpP256dh key `shouldBe` pk
 
-  let pp@(WPP s) :: WPProvider = either error id $ strDecode "webpush https://AAAA@localhost:8000"
+  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://AAAA@localhost:8000/secret"
+  strEncode s <> wpPath params `shouldBe` "https://localhost/secret"

From ca158af8f142ea6f865bbf55ac8fd4596466ed17 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Tue, 28 Oct 2025 14:20:43 +0100
Subject: [PATCH 04/23] Remove unused WPEndpoint

---
 .../Messaging/Notifications/Protocol.hs       | 43 -------------------
 1 file changed, 43 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 119b14107..99c9cf20d 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -12,7 +12,6 @@
 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
@@ -571,14 +570,6 @@ data WPTokenParams = WPTokenParams
   }
   deriving (Eq, Ord, Show)
 
-data WPEndpoint = WPEndpoint
-  { endpoint :: B.ByteString,
-    auth :: B.ByteString,
-    p256dh :: B.ByteString
-  }
-  deriving (Eq, Ord, Show)
-
-
 instance Encoding Auth where
   smpEncode a = smpEncode $ authToByteString a
   smpP = smpP >>= \bs ->
@@ -620,14 +611,6 @@ instance StrEncoding WPKey where
     (wpAuth, wpP256dh) <- strP
     pure WPKey {wpAuth, wpP256dh}
 
-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 Encoding WPTokenParams where
   smpEncode WPTokenParams {wpPath, wpKey} = smpEncode (wpPath, wpKey)
   smpP = do
@@ -643,32 +626,6 @@ instance StrEncoding WPTokenParams where
     wpKey <- strP
     pure WPTokenParams {wpPath, wpKey}
 
-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"
-    -- 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}
-
 data DeviceToken
   = APNSDeviceToken APNSProvider B.ByteString
   | WPDeviceToken WPProvider WPTokenParams

From 974d143b45df423d2c12d8a1361ddef79f917554 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Tue, 28 Oct 2025 17:35:49 +0100
Subject: [PATCH 05/23] Test RFC8291 - webpush encryption - implementation

---
 .../Messaging/Notifications/Protocol.hs       |  7 +++++
 .../Notifications/Server/Push/WebPush.hs      | 20 ++++++++++----
 tests/NtfProtocolTests.hs                     | 26 ++++++++++++++++---
 3 files changed, 44 insertions(+), 9 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 99c9cf20d..7d4a6a021 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -539,6 +539,13 @@ uncompressDecodePoint s
   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
 
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 0929c26c8..a4127bec9 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 (..), WPProvider (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken, APNSDeviceToken), encodePNMessages, PNMessageData, WPKey (..), WPProvider (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, authToByteString)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -65,13 +65,18 @@ wpPushProviderClient mg NtfTknRec {token = WPDeviceToken (WPP s) param} pn = do
     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 :: WPKey -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
-wpEncrypt WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} clearT = do
+wpEncrypt wpKey clearT = do
   salt :: B.ByteString <- liftIO $ getRandomBytes 16
   asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1
-  --let uaPubK = wpP256dh key
+  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
@@ -89,9 +94,14 @@ wpEncrypt WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} clearT = do
   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
-    auth = strEncode wpAuth
+    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
diff --git a/tests/NtfProtocolTests.hs b/tests/NtfProtocolTests.hs
index d20a92807..8eeb1f75e 100644
--- a/tests/NtfProtocolTests.hs
+++ b/tests/NtfProtocolTests.hs
@@ -7,15 +7,17 @@ module NtfProtocolTests 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
-    ( DeviceToken(WPDeviceToken),
-      WPTokenParams(..),
-      WPKey(..),
-      WPProvider(WPP) )
+import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt')
+import Control.Monad.Except (runExceptT)
+import qualified Data.ByteString.Lazy as BL
 
 ntfProtocolTests :: Spec
 ntfProtocolTests = describe "NTF Protocol" $ do
   it "decode WPDeviceToken from string" testWPDeviceTokenStrEncoding
+  it "Encrypt RFC8291 example" testWPEncryption
 
 testWPDeviceTokenStrEncoding :: Expectation
 testWPDeviceTokenStrEncoding = do
@@ -39,3 +41,19 @@ testWPDeviceTokenStrEncoding = do
   -- strEncode parsed `shouldBe` ts
 
   strEncode s <> wpPath params `shouldBe` "https://localhost/secret"
+
+-- | 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"

From a84b659f3161acdcc673c4d1256829055c72d371 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Tue, 28 Oct 2025 17:36:17 +0100
Subject: [PATCH 06/23] Fix tests with -fserver_postgres

---
 tests/AgentTests/NotificationTests.hs | 4 ++--
 tests/NtfClient.hs                    | 2 ++
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 43375c6e3..0912e29b2 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 bd833446c..bdd57f61c 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
 

From 2a0ac142689bfd506b01c30bde8cd5104564ac83 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Wed, 29 Oct 2025 09:46:40 +0100
Subject: [PATCH 07/23] Disable redirections with webpush

---
 src/Simplex/Messaging/Notifications/Server/Env.hs | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index afdfc18ba..ec7ae5166 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
@@ -179,11 +179,21 @@ newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = 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 (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

From bdca3315f4b42ba39122242683e63b4e4bb6f997 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Wed, 29 Oct 2025 23:20:33 +0100
Subject: [PATCH 08/23] Rename webpush tests, and move behind server_postgres
 flag

---
 simplexmq.cabal                              | 2 +-
 tests/{NtfProtocolTests.hs => NtfWPTests.hs} | 4 ++--
 tests/Test.hs                                | 4 ++--
 3 files changed, 5 insertions(+), 5 deletions(-)
 rename tests/{NtfProtocolTests.hs => NtfWPTests.hs} (97%)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 206a28b50..7643515d8 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -483,7 +483,6 @@ test-suite simplexmq-test
       CoreTests.UtilTests
       CoreTests.VersionRangeTests
       FileDescriptionTests
-      NtfProtocolTests
       RemoteControl
       ServerTests
       SMPAgentClient
@@ -509,6 +508,7 @@ test-suite simplexmq-test
           AgentTests.NotificationTests
           NtfClient
           NtfServerTests
+          NtfWPTests
           PostgresSchemaDump
   hs-source-dirs:
       tests
diff --git a/tests/NtfProtocolTests.hs b/tests/NtfWPTests.hs
similarity index 97%
rename from tests/NtfProtocolTests.hs
rename to tests/NtfWPTests.hs
index 8eeb1f75e..9799869c4 100644
--- a/tests/NtfProtocolTests.hs
+++ b/tests/NtfWPTests.hs
@@ -14,8 +14,8 @@ import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt')
 import Control.Monad.Except (runExceptT)
 import qualified Data.ByteString.Lazy as BL
 
-ntfProtocolTests :: Spec
-ntfProtocolTests = describe "NTF Protocol" $ do
+ntfWPTests :: Spec
+ntfWPTests = describe "NTF Protocol" $ do
   it "decode WPDeviceToken from string" testWPDeviceTokenStrEncoding
   it "Encrypt RFC8291 example" testWPEncryption
 
diff --git a/tests/Test.hs b/tests/Test.hs
index a87e60c0b..62837a170 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -40,12 +40,12 @@ import XFTPServerTests (xftpServerTests)
 import Fixtures
 #else
 import AgentTests.SchemaDump (schemaDumpTest)
-import NtfProtocolTests (ntfProtocolTests)
 #endif
 
 #if defined(dbServerPostgres)
 import NtfServerTests (ntfServerTests)
 import NtfClient (ntfTestServerDBConnectInfo, ntfTestStoreDBOpts)
+import NtfProtocolTests (ntfWPTests)
 import PostgresSchemaDump (postgresSchemaDumpTest)
 import SMPClient (testServerDBConnectInfo, testStoreDBOpts)
 import Simplex.Messaging.Notifications.Server.Store.Migrations (ntfServerMigrations)
@@ -140,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
         describe "SMP client agent, jornal message store" $ agentTests (transport @TLS, ASType SQSMemory SMSJournal)
         describe "SMP proxy, jornal message store" $
@@ -151,7 +152,6 @@ main = do
           describe "XFTP agent" xftpAgentTests
         describe "XRCP" remoteControlTests
         describe "Server CLIs" cliTests
-        describe "NTFProtocol" ntfProtocolTests
 
 eventuallyRemove :: FilePath -> Int -> IO ()
 eventuallyRemove path retries = case retries of

From 77f020b4cf8f0e9c751aca915cceac84bfd18251 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Wed, 29 Oct 2025 23:45:20 +0100
Subject: [PATCH 09/23] Parse webpush endpoint with StrEncoding

---
 src/Simplex/Messaging/Notifications/Protocol.hs    | 14 +++++++++++++-
 .../Messaging/Notifications/Server/Push/WebPush.hs |  8 +++-----
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 7d4a6a021..93d18389b 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -40,6 +40,7 @@ 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)
@@ -659,7 +660,10 @@ instance StrEncoding DeviceToken where
       deviceToken =
         strP >>= \case
           PPAPNS p -> APNSDeviceToken p <$> hexStringP
-          PPWP p -> WPDeviceToken p <$> strP
+          PPWP p -> do
+            t <- WPDeviceToken p <$> strP
+            _ <- wpRequest t
+            pure t
       hexStringP = do
         _ <- A.space
         A.takeWhile (`B.elem` "0123456789abcdef") >>= \s ->
@@ -696,6 +700,14 @@ 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
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index a4127bec9..37f0683e7 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 (..), WPProvider (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, authToByteString)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken, APNSDeviceToken), encodePNMessages, PNMessageData, WPKey (..), WPProvider (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, authToByteString, wpRequest)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -35,15 +35,13 @@ 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 Simplex.Messaging.Encoding.String (StrEncoding(..))
 
 wpPushProviderClient :: Manager -> PushProviderClient
 wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
-wpPushProviderClient mg NtfTknRec {token = WPDeviceToken (WPP s) param} pn = do
+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)
   -- parsing will happen in DeviceToken parser, so it won't fail here
-  let endpoint = strEncode s <> wpPath param
-  r <- liftPPWPError $ parseUrlThrow $ B.unpack endpoint
+  r <- wpRequest token
   logDebug $ "Request to " <> tshow (host r)
   encBody <- body
   let requestHeaders =

From 58c9f0d521e7ef223bebdead1cc06224cdc1ac86 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Thu, 30 Oct 2025 08:40:24 +0100
Subject: [PATCH 10/23] Fix rename webpush tests

---
 tests/NtfWPTests.hs | 2 +-
 tests/Test.hs       | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 9799869c4..6299912ba 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE DataKinds #-}
 
-module NtfProtocolTests where
+module NtfWPTests where
 
 import Test.Hspec hiding (fit, it)
 import Util
diff --git a/tests/Test.hs b/tests/Test.hs
index 62837a170..884a1a7b1 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -45,7 +45,7 @@ import AgentTests.SchemaDump (schemaDumpTest)
 #if defined(dbServerPostgres)
 import NtfServerTests (ntfServerTests)
 import NtfClient (ntfTestServerDBConnectInfo, ntfTestStoreDBOpts)
-import NtfProtocolTests (ntfWPTests)
+import NtfWPTests (ntfWPTests)
 import PostgresSchemaDump (postgresSchemaDumpTest)
 import SMPClient (testServerDBConnectInfo, testStoreDBOpts)
 import Simplex.Messaging.Notifications.Server.Store.Migrations (ntfServerMigrations)

From a9c73096618f45db1ee1a89e486d6e870537a8e2 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Thu, 30 Oct 2025 13:57:54 +0100
Subject: [PATCH 11/23] Lint import

---
 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 37f0683e7..58eb3fa58 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 (..), WPProvider (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, authToByteString, wpRequest)
+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

From 82bcf4274e189fe2b67b8887340e78c018833a67 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Thu, 30 Oct 2025 13:58:32 +0100
Subject: [PATCH 12/23] Test push notification encoding for webpush

---
 tests/NtfWPTests.hs | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 6299912ba..64bc7bd33 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -10,14 +10,19 @@ 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')
+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(..))
 
 ntfWPTests :: Spec
 ntfWPTests = describe "NTF Protocol" $ do
   it "decode WPDeviceToken from string" testWPDeviceTokenStrEncoding
   it "Encrypt RFC8291 example" testWPEncryption
+  it "PushNotifications encoding" testPNEncoding
 
 testWPDeviceTokenStrEncoding :: Expectation
 testWPDeviceTokenStrEncoding = do
@@ -57,3 +62,19 @@ testWPEncryption = do
     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 :| []

From f8674163b29aa6f23d6d6ed2eaef573cdcf6d84b Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Thu, 30 Oct 2025 15:24:29 +0100
Subject: [PATCH 13/23] Test strDecoding invalid WPDeviceToken

---
 tests/NtfWPTests.hs | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 64bc7bd33..6068e5d3e 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -17,10 +17,12 @@ 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
 
@@ -47,6 +49,15 @@ testWPDeviceTokenStrEncoding = do
 
   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

From 1ce3d5ac4e47d6b87020a54334571d4058f18b5d Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Thu, 30 Oct 2025 17:28:45 +0100
Subject: [PATCH 14/23] 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 46d8dd10a..8adaf06cc 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -86,6 +86,7 @@ module Simplex.Messaging.Crypto
     signatureKeyPair,
     publicToX509,
     encodeASNObj,
+    readECPrivateKey,
 
     -- * key encoding/decoding
     encodePubKey,
@@ -93,6 +94,9 @@ module Simplex.Messaging.Crypto
     encodePrivKey,
     decodePrivKey,
     pubKeyBytes,
+    uncompressEncodePoint,
+    uncompressDecodePoint,
+    uncompressDecodePrivateNumber,
 
     -- * sign/verify
     Signature (..),
@@ -251,6 +255,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
@@ -1532,3 +1542,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 93d18389b..a7242bb8c 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -520,57 +520,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 :: B.ByteString,
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index a2a954b08..1f3579545 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 24652c81e..4e6b099e1 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 58eb3fa58..24beb7a39 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 (WPDeviceToken, APNSDeviceToken), encodePNMessages, PNMessageData, WPKey (..), WPTokenParams (..), WPP256dh (..), authToByteString, wpRequest)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -75,8 +75,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 auth ecdhSecret
       keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS
diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 6068e5d3e..5b0cfb82a 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 58f805757878c937acb98debc34e1366a8ed8883 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 07:47:22 +0100
Subject: [PATCH 15/23] 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 ec7ae5166..46d6d0be1 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 de12c33f8..fd54680ba 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 24beb7a39..67fd88303 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -35,6 +35,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 0912e29b2..5b495c783 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 bdd57f61c..275d0bab0 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 000000000..294260c2d
--- /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 c4802f188dec83ff551c80f8ac1ed848193919c6 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 09:16:58 +0100
Subject: [PATCH 16/23] Send VAPID header with webpush requests

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

diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index a7242bb8c..c7d90dee7 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 46d6d0be1..d6a859905 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,11 +180,12 @@ newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do
   pure c
 
 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)
   manager <- wpHTTPManager
-  let c = wpPushProviderClient manager
+  cache <- newIORef Nothing
+  let c = wpPushProviderClient wpConfig cache manager
   atomically $ TM.insert (PPWP pp) c pushClients
   pure c
 
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index 1f3579545..1039e5448 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 4e6b099e1..929360b53 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 67fd88303..4c4393dad 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 (..), authToByteString, wpRequest)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken, APNSDeviceToken), encodePNMessages, PNMessageData, WPKey (..), WPTokenParams (..), WPP256dh (..), authToByteString, wpRequest, wpAud)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -37,6 +37,9 @@ 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)
 
 -- | Vapid
 -- | fp: fingerprint, base64url encoded without padding
@@ -56,18 +59,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 =
@@ -82,6 +143,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 $ encodePN 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 5b0cfb82a..a142c2ef3 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', encodePN, 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 befd68196fc9e07a597fbcb0247c049aedbff568 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 09:32:19 +0100
Subject: [PATCH 17/23] 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 4c4393dad..798645adc 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -70,7 +70,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 12adbe505f414c5441ea4bf82dc0ac501f0b5b96 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 10:00:56 +0100
Subject: [PATCH 18/23] 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 798645adc..4bbdec368 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
@@ -53,7 +53,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 bfe8470f8e7b964804378ce7ec53f718768314a8 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 09:41:23 +0100
Subject: [PATCH 19/23] Add function to verify saved ntf token, with
 unencrypted code

---
 src/Simplex/Messaging/Agent.hs | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 27967bfd6..2c792ebd2 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -97,6 +97,7 @@ module Simplex.Messaging.Agent
     reconnectSMPServer,
     registerNtfToken,
     verifyNtfToken,
+    verifySavedNtfToken,
     checkNtfToken,
     deleteNtfToken,
     getNtfToken,
@@ -592,6 +593,11 @@ verifyNtfToken :: AgentClient -> NetworkRequestMode -> DeviceToken -> C.CbNonce
 verifyNtfToken c = withAgentEnv c .:: verifyNtfToken' c
 {-# INLINE verifyNtfToken #-}
 
+-- | Verify saved device notifications token
+verifySavedNtfToken :: AgentClient -> NetworkRequestMode -> ByteString -> AE ()
+verifySavedNtfToken c = withAgentEnv c .: verifySavedNtfToken' c
+{-# INLINE verifySavedNtfToken #-}
+
 checkNtfToken :: AgentClient -> NetworkRequestMode -> DeviceToken -> AE NtfTknStatus
 checkNtfToken c = withAgentEnv c .: checkNtfToken' c
 {-# INLINE checkNtfToken #-}
@@ -2359,6 +2365,19 @@ verifyNtfToken' c nm deviceToken nonce code =
         when (ntfMode == NMInstant) $ initializeNtfSubs c
     _ -> throwE $ CMD PROHIBITED "verifyNtfToken: no token"
 
+verifySavedNtfToken' :: AgentClient -> NetworkRequestMode -> ByteString -> AM ()
+verifySavedNtfToken' c nm code =
+  withStore' c getSavedNtfToken >>= \case
+    Just tkn@NtfToken {ntfTokenId = Just tknId, ntfMode} -> do
+      let code' = NtfRegCode code
+      toStatus <-
+        withToken c nm tkn (Just (NTConfirmed, NTAVerify code')) (NTActive, Just NTACheck) $
+          agentNtfVerifyToken c nm tknId tkn code'
+      when (toStatus == NTActive) $ do
+        lift $ setCronInterval c nm tknId tkn
+        when (ntfMode == NMInstant) $ initializeNtfSubs c
+    _ -> throwE $ CMD PROHIBITED "verifySavedNtfToken: no token"
+
 setCronInterval :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToken -> AM' ()
 setCronInterval c nm tknId tkn = do
   cron <- asks $ ntfCron . config

From 15154ef75168f115e54220c8f906c30bab071eae Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Fri, 31 Oct 2025 09:48:44 +0100
Subject: [PATCH 20/23] Add function to delete saved ntf token

---
 src/Simplex/Messaging/Agent.hs | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 2c792ebd2..e965d8520 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -100,6 +100,7 @@ module Simplex.Messaging.Agent
     verifySavedNtfToken,
     checkNtfToken,
     deleteNtfToken,
+    deleteSavedNtfToken,
     getNtfToken,
     getNtfTokenData,
     toggleConnectionNtfs,
@@ -606,6 +607,10 @@ deleteNtfToken :: AgentClient -> DeviceToken -> AE ()
 deleteNtfToken c = withAgentEnv c . deleteNtfToken' c
 {-# INLINE deleteNtfToken #-}
 
+deleteSavedNtfToken :: AgentClient -> AE ()
+deleteSavedNtfToken c = withAgentEnv c $ deleteSavedNtfToken' c
+{-# INLINE deleteSavedNtfToken #-}
+
 getNtfToken :: AgentClient -> AE (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
 getNtfToken c = withAgentEnv c $ getNtfToken' c
 {-# INLINE getNtfToken #-}
@@ -2406,6 +2411,15 @@ deleteNtfToken' c deviceToken =
       deleteNtfSubs c NSCSmpDelete
     _ -> throwE $ CMD PROHIBITED "deleteNtfToken: no token"
 
+
+deleteSavedNtfToken' :: AgentClient -> AM ()
+deleteSavedNtfToken' c =
+  withStore' c getSavedNtfToken >>= \case
+    Just tkn -> do
+      deleteToken c tkn
+      deleteNtfSubs c NSCSmpDelete
+    _ -> throwE $ CMD PROHIBITED "deleteSavedNtfToken: no token"
+
 getNtfToken' :: AgentClient -> AM (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
 getNtfToken' c =
   withStore' c getSavedNtfToken >>= \case

From d4610e72d500cc2d821b050c7928802c5e61d532 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Tue, 4 Nov 2025 21:21:22 +0100
Subject: [PATCH 21/23] Fix compilation for client lib

---
 simplexmq.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 7643515d8..df4cc5619 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -306,6 +306,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.*
@@ -337,7 +338,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.*

From 814763b771b070390c2dac6464e04d634ef019f0 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Tue, 4 Nov 2025 21:21:35 +0100
Subject: [PATCH 22/23] Print VAPID fp

---
 src/Simplex/Messaging/Notifications/Server/Main.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs
index fd54680ba..9c9b59bad 100644
--- a/src/Simplex/Messaging/Notifications/Server/Main.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Main.hs
@@ -57,7 +57,7 @@ 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 Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig(..), VapidKey(..), mkVapid)
 
 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

From 359507c780c41fd8bc45a3581c82453ed877ac21 Mon Sep 17 00:00:00 2001
From: sim <git@sgougeon.fr>
Date: Wed, 5 Nov 2025 12:01:03 +0100
Subject: [PATCH 23/23] Fix VAPID signature

---
 src/Simplex/Messaging/Crypto.hs                       |  1 +
 src/Simplex/Messaging/Notifications/Server/Push.hs    | 11 +++++++++++
 .../Messaging/Notifications/Server/Push/WebPush.hs    |  4 ++--
 3 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 8adaf06cc..7ae139cf6 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -94,6 +94,7 @@ module Simplex.Messaging.Crypto
     encodePrivKey,
     decodePrivKey,
     pubKeyBytes,
+    encodeBigInt,
     uncompressEncodePoint,
     uncompressDecodePoint,
     uncompressDecodePrivateNumber,
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index 1039e5448..296b686d3 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -89,6 +89,17 @@ 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]
 
+-- | Does it work with APNS ?
+signedJWTTokenRawSign :: EC.PrivateKey -> JWTToken -> IO SignedJWTToken
+signedJWTTokenRawSign 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 $ LB.toStrict $ C.encodeBigInt (EC.sign_r sig) <> C.encodeBigInt (EC.sign_s sig)
+
 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
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 4bbdec368..df8fc8b1a 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -109,11 +109,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 <- signedJWTTokenRawSign key jwt
   pure $ "vapid t=" <> signedToken <> ",k=" <> fp
 
 wpPushProviderClient :: WebPushConfig -> IORef (Maybe WPCache) -> Manager -> PushProviderClient