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/13] 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/13] 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/13] 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/13] 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/13] 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/13] 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/13] 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/13] 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/13] 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/13] 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/13] 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/13] 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/13] 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