From 3402d64029ec2a80d3c89a672efd58c2aedb2e6c Mon Sep 17 00:00:00 2001 From: sim Date: Thu, 30 Oct 2025 17:28:45 +0100 Subject: [PATCH 1/5] 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 1fa2c6d4c..a214d9b2c 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -87,6 +87,7 @@ module Simplex.Messaging.Crypto signatureKeyPair, publicToX509, encodeASNObj, + readECPrivateKey, -- * key encoding/decoding encodePubKey, @@ -94,6 +95,9 @@ module Simplex.Messaging.Crypto encodePrivKey, decodePrivKey, pubKeyBytes, + uncompressEncodePoint, + uncompressDecodePoint, + uncompressDecodePrivateNumber, -- * sign/verify Signature (..), @@ -252,6 +256,12 @@ import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (parseAll, parseString) import Simplex.Messaging.Util ((<$?>)) +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.Store.PKCS8 as PK +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Data.ByteString.Lazy as BL +import qualified Data.Binary as Bin +import qualified Data.Bits as Bits -- | Cryptographic algorithms. data Algorithm = Ed25519 | Ed448 | X25519 | X448 @@ -1542,3 +1552,56 @@ keyError :: (a, [ASN1]) -> Either String b keyError = \case (_, []) -> Left "unknown key algorithm" _ -> Left "more than one key" + +readECPrivateKey :: FilePath -> IO ECDSA.PrivateKey +readECPrivateKey f = do + -- this pattern match is specific to APNS key type, it may need to be extended for other push providers + [PK.Unprotected (X.PrivKeyEC X.PrivKeyEC_Named {privkeyEC_name, privkeyEC_priv})] <- PK.readKeyFile f + pure ECDSA.PrivateKey {private_curve = ECC.getCurveByName privkeyEC_name, private_d = privkeyEC_priv} + +-- | Elliptic-Curve-Point-to-Octet-String Conversion without compression +-- | as required by RFC8291 +-- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3 +uncompressEncodePoint :: ECC.Point -> BL.ByteString +uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y +uncompressEncodePoint ECC.PointO = "\0" + +uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point +uncompressDecodePoint "\0" = pure ECC.PointO +uncompressDecodePoint s + | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported + | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid + | otherwise = do + let s' = BL.drop 1 s + x <- decodeBigInt $ BL.take 32 s' + y <- decodeBigInt $ BL.drop 32 s' + pure $ ECC.Point x y + where + prefix = "\x04" :: BL.ByteString + +-- Used to test encryption against the RFC8291 Example - which gives the AS private key +uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber +uncompressDecodePrivateNumber s + | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid + | otherwise = do + decodeBigInt s + +encodeBigInt :: Integer -> BL.ByteString +encodeBigInt i = do + let s1 = Bits.shiftR i 64 + s2 = Bits.shiftR s1 64 + s3 = Bits.shiftR s2 64 + Bin.encode (w64 s3, w64 s2, w64 s1, w64 i) + where + w64 :: Integer -> Bin.Word64 + w64 = fromIntegral + +decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer +decodeBigInt s + | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid + | otherwise = do + let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 ) + pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0 + where + shift i w = Bits.shiftL (fromIntegral w) (64 * i) + diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 42e6c09db..7957e0ad8 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -484,57 +484,11 @@ data WPKey = WPKey } deriving (Eq, Ord, Show) --- | Elliptic-Curve-Point-to-Octet-String Conversion without compression --- | as required by RFC8291 --- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3 -uncompressEncodePoint :: ECC.Point -> BL.ByteString -uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y -uncompressEncodePoint ECC.PointO = "\0" - -uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point -uncompressDecodePoint "\0" = pure ECC.PointO -uncompressDecodePoint s - | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported - | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid - | otherwise = do - let s' = BL.drop 1 s - x <- decodeBigInt $ BL.take 32 s' - y <- decodeBigInt $ BL.drop 32 s' - pure $ ECC.Point x y - where - prefix = "\x04" :: BL.ByteString - --- Used to test encryption against the RFC8291 Example - which gives the AS private key -uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber -uncompressDecodePrivateNumber s - | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid - | otherwise = do - decodeBigInt s - uncompressEncode :: WPP256dh -> BL.ByteString -uncompressEncode (WPP256dh p) = uncompressEncodePoint p +uncompressEncode (WPP256dh p) = C.uncompressEncodePoint p uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh -uncompressDecode bs = WPP256dh <$> uncompressDecodePoint bs - -encodeBigInt :: Integer -> BL.ByteString -encodeBigInt i = do - let s1 = Bits.shiftR i 64 - s2 = Bits.shiftR s1 64 - s3 = Bits.shiftR s2 64 - Bin.encode (w64 s3, w64 s2, w64 s1, w64 i) - where - w64 :: Integer -> Bin.Word64 - w64 = fromIntegral - -decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer -decodeBigInt s - | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid - | otherwise = do - let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 ) - pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0 - where - shift i w = Bits.shiftL (fromIntegral w) (64 * i) +uncompressDecode bs = WPP256dh <$> C.uncompressDecodePoint bs data WPTokenParams = WPTokenParams { wpPath :: ByteString, diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs index 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 9b1ebb9f8..c729cecc2 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -10,7 +10,7 @@ module Simplex.Messaging.Notifications.Server.Push.WebPush where import Network.HTTP.Client import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest) +import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest) import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Notifications.Server.Push import Control.Monad.Except @@ -72,8 +72,8 @@ wpEncrypt wpKey clearT = do -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 wpEncrypt' :: WPKey -> ECC.PrivateNumber -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do - let uaPubKS = BL.toStrict . uncompressEncodePoint $ uaPubK - let asPubKS = BL.toStrict . uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK + let uaPubKS = BL.toStrict . C.uncompressEncodePoint $ uaPubK + let asPubKS = BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK prkKey = hmac (unWPAuth wpAuth) ecdhSecret keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs index 8a5fcf180..64d04f86e 100644 --- a/tests/NtfWPTests.hs +++ b/tests/NtfWPTests.hs @@ -65,7 +65,7 @@ testWPEncryption = do let pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4" let salt :: B.ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw" let privBS :: BL.ByteString = either error BL.fromStrict $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw" - asPriv :: ECC.PrivateNumber <- case uncompressDecodePrivateNumber privBS of + asPriv :: ECC.PrivateNumber <- case C.uncompressDecodePrivateNumber privBS of Left e -> fail $ "Cannot decode PrivateNumber from b64 " <> show e Right p -> pure p mCip <- runExceptT $ wpEncrypt' (wpKey pParams) asPriv salt clearT From c50c77dbade4938dd9f01718721469b5b313a32f Mon Sep 17 00:00:00 2001 From: sim Date: Fri, 31 Oct 2025 07:47:22 +0100 Subject: [PATCH 2/5] 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 83608ebcd..b15e45d83 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 "" 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 "") 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 c729cecc2..959eb3fd6 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -32,6 +32,26 @@ import qualified Crypto.Cipher.Types as CT import qualified Crypto.MAC.HMAC as HMAC import qualified Crypto.PubKey.ECC.DH as ECDH import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Data.ByteString.Base64.URL as B64 + +-- | Vapid +-- | fp: fingerprint, base64url encoded without padding +-- | key: privkey +data VapidKey = VapidKey + { key::ECDSA.PrivateKey, + fp::B.ByteString + } + deriving (Eq, Show) + +mkVapid :: ECDSA.PrivateKey -> VapidKey +mkVapid key = VapidKey { key, fp } + where + fp = B64.encodeUnpadded . B.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key + +data WebPushConfig = WebPushConfig + { vapidKey :: VapidKey + } wpPushProviderClient :: Manager -> PushProviderClient wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 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 49a7e26a2fa23e0ad5f6a98de61a837169995df2 Mon Sep 17 00:00:00 2001 From: sim Date: Fri, 31 Oct 2025 09:16:58 +0100 Subject: [PATCH 3/5] Send VAPID header with webpush requests --- .../Messaging/Notifications/Protocol.hs | 3 + .../Messaging/Notifications/Server/Env.hs | 7 +- .../Messaging/Notifications/Server/Push.hs | 34 +++++++-- .../Notifications/Server/Push/APNS.hs | 5 +- .../Notifications/Server/Push/WebPush.hs | 73 +++++++++++++++++-- tests/NtfWPTests.hs | 32 +++++++- 6 files changed, 139 insertions(+), 15 deletions(-) diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 7957e0ad8..dfc18013e 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 b15e45d83..1b3ad1230 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -49,6 +49,7 @@ import UnliftIO.STM import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient, WebPushConfig) import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager) import Network.HTTP.Client.TLS (tlsManagerSettings) +import Data.IORef (newIORef) data NtfServerConfig = NtfServerConfig { transports :: [(ServiceName, ASrvTransport, AddHTTP)], @@ -179,10 +180,12 @@ newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient -newWPPushClient NtfPushServer {pushClients} pp = do +newWPPushClient NtfPushServer {wpConfig, pushClients} pp = do logDebug "New WP Client requested" -- We use one http manager per push server (which may be used by different clients) - wpPushProviderClient <$> wpHTTPManager + manager <- wpHTTPManager + cache <- newIORef Nothing + pure $ wpPushProviderClient wpConfig cache manager wpHTTPManager :: IO Manager wpHTTPManager = newManager tlsManagerSettings { diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs index 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 959eb3fd6..704726380 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -10,7 +10,7 @@ module Simplex.Messaging.Notifications.Server.Push.WebPush where import Network.HTTP.Client import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest) +import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest, wpAud) import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Notifications.Server.Push import Control.Monad.Except @@ -34,6 +34,10 @@ import qualified Crypto.PubKey.ECC.DH as ECDH import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Data.ByteString.Base64.URL as B64 +import Data.IORef +import Data.Int (Int64) +import Data.Time.Clock.System (systemSeconds, getSystemTime) +import qualified Data.Text.Encoding as T -- | Vapid -- | fp: fingerprint, base64url encoded without padding @@ -53,18 +57,76 @@ data WebPushConfig = WebPushConfig { vapidKey :: VapidKey } -wpPushProviderClient :: Manager -> PushProviderClient -wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher -wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = do +data WPCache = WPCache + { vapidHeader :: B.ByteString, + expire :: Int64 + } + +getVapidHeader :: VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString +getVapidHeader vapidK cache uriAuthority = do + h <- readIORef cache + now <- systemSeconds <$> getSystemTime + case h of + Nothing -> newCacheEntry now + Just entry -> if expire entry > now then pure $ vapidHeader entry + else newCacheEntry now + where + newCacheEntry :: Int64 -> IO B.ByteString + newCacheEntry now = do + -- The new entry expires in one hour + let expire = now + 3600 + vapidHeader <- mkVapidHeader vapidK uriAuthority expire + let entry = Just WPCache { vapidHeader, expire } + atomicWriteIORef cache entry + pure vapidHeader + +-- | With time in input for the tests +getVapidHeader' :: Int64 -> VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString +getVapidHeader' now vapidK cache uriAuthority = do + h <- readIORef cache + case h of + Nothing -> newCacheEntry + Just entry -> if expire entry > now then pure $ vapidHeader entry + else newCacheEntry + where + newCacheEntry :: IO B.ByteString + newCacheEntry = do + -- The new entry expires in one hour + let expire = now + 3600 + vapidHeader <- mkVapidHeader vapidK uriAuthority expire + let entry = Just WPCache { vapidHeader, expire } + atomicWriteIORef cache entry + pure vapidHeader + +-- | mkVapidHeader -> vapid -> endpoint -> expire -> vapid header +mkVapidHeader :: VapidKey -> B.ByteString -> Int64 -> IO B.ByteString +mkVapidHeader VapidKey {key, fp} uriAuthority expire = do + let jwtHeader = mkJWTHeader "ES256" Nothing + jwtClaims = JWTClaims + { iss = Nothing, + iat = Nothing, + exp = Just expire, + aud = Just $ T.decodeUtf8 uriAuthority, + sub = Just "https://github.com/simplex-chat/simplexmq/" + } + jwt = JWTToken jwtHeader jwtClaims + signedToken <- signedJWTToken key jwt + pure $ "vapid t=" <> signedToken <> ",k=" <> fp + +wpPushProviderClient :: WebPushConfig -> IORef (Maybe WPCache) -> Manager -> PushProviderClient +wpPushProviderClient _ _ _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher +wpPushProviderClient conf cache mg NtfTknRec {token = token@(WPDeviceToken pp param)} pn = do -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams) -- parsing will happen in DeviceToken parser, so it won't fail here r <- wpRequest token + vapidH <- liftPPWPError $ getVapidHeader (vapidKey conf) cache aud logDebug $ "Request to " <> tshow (host r) encBody <- body let requestHeaders = [ ("TTL", "2592000"), -- 30 days ("Urgency", "high"), - ("Content-Encoding", "aes128gcm") + ("Content-Encoding", "aes128gcm"), + ("Authorization", vapidH) -- TODO: topic for pings and interval ] req = @@ -79,6 +141,7 @@ wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = d where body :: ExceptT PushProviderError IO B.ByteString body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn) + aud = wpAud pp -- | encrypt :: UA key -> clear -> cipher -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs index 64d04f86e..b884c964b 100644 --- a/tests/NtfWPTests.hs +++ b/tests/NtfWPTests.hs @@ -10,7 +10,7 @@ import Simplex.Messaging.Encoding.String (StrEncoding(..)) import qualified Data.ByteString as B import qualified Crypto.PubKey.ECC.Types as ECC import Simplex.Messaging.Notifications.Protocol -import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN) +import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN, getVapidHeader') import Control.Monad.Except (runExceptT) import qualified Data.ByteString.Lazy as BL import Simplex.Messaging.Notifications.Server.Push @@ -18,6 +18,9 @@ import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Simplex.Messaging.Crypto as C import Data.Time.Clock.System (SystemTime(..)) import Data.Either (isLeft) +import Data.IORef (newIORef) +import Simplex.Messaging.Notifications.Server.Main (getVapidKey) +import Control.Monad (unless) ntfWPTests :: Spec ntfWPTests = describe "NTF Protocol" $ do @@ -25,6 +28,7 @@ ntfWPTests = describe "NTF Protocol" $ do it "decode invalid WPDeviceToken" testInvalidWPDeviceTokenStrEncoding it "Encrypt RFC8291 example" testWPEncryption it "PushNotifications encoding" testPNEncoding + it "Vapid header cache" testVapidCache testWPDeviceTokenStrEncoding :: Expectation testWPDeviceTokenStrEncoding = do @@ -89,3 +93,29 @@ testPNEncoding = do let smpQ = either error id $ strDecode "smp://AAAA@l/AAAA" let now = MkSystemTime 1761827386 0 PNMessage $ PNMessageData smpQ now (C.cbNonce "nonce") m :| [] + +testVapidCache :: Expectation +testVapidCache = do + let wpaud = "https://localhost" + let now = 1761900906 + cache <- newIORef Nothing + vapidKey <- getVapidKey "tests/fixtures/vapid.privkey" + v1 <- getVapidHeader' now vapidKey cache wpaud + v2 <- getVapidHeader' now vapidKey cache wpaud + v1 `shouldBe` v2 + -- we just don't test the signature here + v1 `shouldContainBS` "vapid t=eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9.eyJleHAiOjE3NjE5MDQ1MDYsImF1ZCI6Imh0dHBzOi8vbG9jYWxob3N0Iiwic3ViIjoiaHR0cHM6Ly9naXRodWIuY29tL3NpbXBsZXgtY2hhdC9zaW1wbGV4bXEvIn0." + v1 `shouldContainBS` ",k=BIk7ASkEr1A1rJRGXMKi77tAGj3dRouSgZdW6S5pee7a3h7fkvd0OYQixy4yj35UFZt8hd9TwAQiybDK_HJLwJA" + v3 <- getVapidHeader' (now + 3600) vapidKey cache wpaud + v1 `shouldNotBe` v3 + v3 `shouldContainBS` "vapid t=eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9." + v3 `shouldContainBS` ",k=BIk7ASkEr1A1rJRGXMKi77tAGj3dRouSgZdW6S5pee7a3h7fkvd0OYQixy4yj35UFZt8hd9TwAQiybDK_HJLwJA" + +shouldContainBS :: B.ByteString -> B.ByteString -> Expectation +shouldContainBS actual expected = + unless (expected `B.isInfixOf` actual) $ + expectationFailure $ + "Expected ByteString to contain:\n" ++ + show expected ++ + "\nBut got:\n" ++ + show actual From 28aa2da55c4787f05929835319b8d8d91788fbdc Mon Sep 17 00:00:00 2001 From: sim Date: Fri, 31 Oct 2025 09:32:19 +0100 Subject: [PATCH 4/5] 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 704726380..7794deb47 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -68,7 +68,8 @@ getVapidHeader vapidK cache uriAuthority = do now <- systemSeconds <$> getSystemTime case h of Nothing -> newCacheEntry now - Just entry -> if expire entry > now then pure $ vapidHeader entry + -- if it expires in 1 min, then we renew - for safety + Just entry -> if expire entry > now + 60 then pure $ vapidHeader entry else newCacheEntry now where newCacheEntry :: Int64 -> IO B.ByteString From 323d6daadf5794545482e278749fdd9fcd38a330 Mon Sep 17 00:00:00 2001 From: sim Date: Fri, 31 Oct 2025 10:00:56 +0100 Subject: [PATCH 5/5] 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 7794deb47..184d07a38 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -16,7 +16,7 @@ import Simplex.Messaging.Notifications.Server.Push import Control.Monad.Except import Control.Logger.Simple (logDebug) import Simplex.Messaging.Util (tshow) -import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString as B import Control.Monad.IO.Class (liftIO) import Control.Exception ( fromException, SomeException, try ) import qualified Network.HTTP.Types as N @@ -51,7 +51,7 @@ data VapidKey = VapidKey mkVapid :: ECDSA.PrivateKey -> VapidKey mkVapid key = VapidKey { key, fp } where - fp = B64.encodeUnpadded . B.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key + fp = B64.encodeUnpadded . BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key data WebPushConfig = WebPushConfig { vapidKey :: VapidKey