From 8d95f1b30eb399ddbb900c9d967751a5bf2e7942 Mon Sep 17 00:00:00 2001 From: sim Date: Wed, 12 Nov 2025 17:17:16 +0100 Subject: [PATCH 1/4] WIP: add test to check webpush requests from ntf server --- tests/AgentTests/NotificationTests.hs | 64 ++++++++--------- tests/NtfClient.hs | 98 ++++++++++++++++++++------- tests/NtfServerTests.hs | 53 +++++++++++---- 3 files changed, 148 insertions(+), 67 deletions(-) diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 5b495c783..d59609951 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -217,11 +217,11 @@ runNtfTestCfg (t, msType) baseId smpCfg ntfCfg' aCfg bCfg runTest = do threadDelay 100000 testNotificationToken :: APNSMockServer -> IO () -testNotificationToken apns = do +testNotificationToken (APNSMockServer apns) = do withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do let tkn = APNSDeviceToken PPApnsTest "abcd" NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn verification <- ntfData .-> "verification" nonce <- C.cbNonce <$> ntfData .-> "nonce" @@ -241,16 +241,16 @@ v .-> key = do -- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} testNtfTokenRepeatRegistration :: APNSMockServer -> IO () -testNtfTokenRepeatRegistration apns = do +testNtfTokenRepeatRegistration (APNSMockServer apns) = do withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do let tkn = APNSDeviceToken PPApnsTest "abcd" NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn verification <- ntfData .-> "verification" nonce <- C.cbNonce <$> ntfData .-> "nonce" NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <- getMockNotification apns tkn _ <- ntfData' .-> "verification" _ <- C.cbNonce <$> ntfData' .-> "nonce" @@ -260,18 +260,18 @@ testNtfTokenRepeatRegistration apns = do pure () testNtfTokenSecondRegistration :: APNSMockServer -> IO () -testNtfTokenSecondRegistration apns = +testNtfTokenSecondRegistration (APNSMockServer apns) = withAgentClients2 $ \a a' -> runRight_ $ do let tkn = APNSDeviceToken PPApnsTest "abcd" NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn verification <- ntfData .-> "verification" nonce <- C.cbNonce <$> ntfData .-> "nonce" verifyNtfToken a tkn nonce verification NTRegistered <- registerNtfToken a' tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <- getMockNotification apns tkn verification' <- ntfData' .-> "verification" nonce' <- C.cbNonce <$> ntfData' .-> "nonce" @@ -290,12 +290,12 @@ testNtfTokenSecondRegistration apns = pure () testNtfTokenServerRestart :: ASrvTransport -> APNSMockServer -> IO () -testNtfTokenServerRestart t apns = do +testNtfTokenServerRestart t (APNSMockServer apns) = do let tkn = APNSDeviceToken PPApnsTest "abcd" ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a -> withNtfServer t $ runRight $ do NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn pure ntfData -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server @@ -311,12 +311,12 @@ testNtfTokenServerRestart t apns = do pure () testNtfTokenServerRestartReverify :: ASrvTransport -> APNSMockServer -> IO () -testNtfTokenServerRestartReverify t apns = do +testNtfTokenServerRestartReverify t (APNSMockServer apns) = do let tkn = APNSDeviceToken PPApnsTest "abcd" withAgent 1 agentCfg initAgentServers testDB $ \a -> do ntfData <- withNtfServer t $ runRight $ do NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn pure ntfData runRight_ $ do @@ -334,12 +334,12 @@ testNtfTokenServerRestartReverify t apns = do pure () testNtfTokenServerRestartReverifyTimeout :: ASrvTransport -> APNSMockServer -> IO () -testNtfTokenServerRestartReverifyTimeout t apns = do +testNtfTokenServerRestartReverifyTimeout t (APNSMockServer apns) = do let tkn = APNSDeviceToken PPApnsTest "abcd" withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do (nonce, verification) <- withNtfServer t $ runRight $ do NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn verification <- ntfData .-> "verification" nonce <- C.cbNonce <$> ntfData .-> "nonce" @@ -369,12 +369,12 @@ testNtfTokenServerRestartReverifyTimeout t apns = do pure () testNtfTokenServerRestartReregister :: ASrvTransport -> APNSMockServer -> IO () -testNtfTokenServerRestartReregister t apns = do +testNtfTokenServerRestartReregister t (APNSMockServer apns) = do let tkn = APNSDeviceToken PPApnsTest "abcd" withAgent 1 agentCfg initAgentServers testDB $ \a -> withNtfServer t $ runRight $ do NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <- getMockNotification apns tkn pure () -- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server @@ -384,7 +384,7 @@ testNtfTokenServerRestartReregister t apns = do -- so that repeat registration happens when client is restarted. withNtfServer t $ runRight_ $ do NTRegistered <- registerNtfToken a' tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn verification <- ntfData .-> "verification" nonce <- C.cbNonce <$> ntfData .-> "nonce" @@ -393,12 +393,12 @@ testNtfTokenServerRestartReregister t apns = do pure () testNtfTokenServerRestartReregisterTimeout :: ASrvTransport -> APNSMockServer -> IO () -testNtfTokenServerRestartReregisterTimeout t apns = do +testNtfTokenServerRestartReregisterTimeout t (APNSMockServer apns) = do let tkn = APNSDeviceToken PPApnsTest "abcd" withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do withNtfServer t $ runRight $ do NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <- getMockNotification apns tkn pure () -- this emulates the situation when server registered token but the client did not receive the response @@ -419,7 +419,7 @@ testNtfTokenServerRestartReregisterTimeout t apns = do -- so that repeat registration happens when client is restarted. withNtfServer t $ runRight_ $ do NTRegistered <- registerNtfToken a' tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn verification <- ntfData .-> "verification" nonce <- C.cbNonce <$> ntfData .-> "nonce" @@ -434,14 +434,14 @@ getTestNtfTokenPort a = Nothing -> error "no active NtfToken" testNtfTokenMultipleServers :: ASrvTransport -> APNSMockServer -> IO () -testNtfTokenMultipleServers t apns = do +testNtfTokenMultipleServers t (APNSMockServer apns) = do let tkn = APNSDeviceToken PPApnsTest "abcd" withAgent 1 agentCfg initAgentServers2 testDB $ \a -> withNtfServerThreadOn t ntfTestPort ntfTestDBCfg $ \ntf -> withNtfServerThreadOn t ntfTestPort2 ntfTestDBCfg2 $ \ntf2 -> runRight_ $ do -- register a new token, the agent picks a server and stores its choice NTRegistered <- registerNtfToken a tkn NMPeriodic - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn verification <- ntfData .-> "verification" nonce <- C.cbNonce <$> ntfData .-> "nonce" @@ -544,7 +544,7 @@ testRunNTFServerTests t srv = testProtocolServer a NRMInteractive 1 $ ProtoServerWithAuth srv Nothing testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO () -testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do +testNotificationSubscriptionExistingConnection (APNSMockServer apns) baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do (bobId, aliceId, nonce, message) <- runRight $ do -- establish connection (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe @@ -557,7 +557,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag -- register notification token let tkn = APNSDeviceToken PPApnsTest "abcd" NTRegistered <- registerNtfToken alice tkn NMInstant - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn verification <- ntfData .-> "verification" vNonce <- C.cbNonce <$> ntfData .-> "nonce" @@ -567,7 +567,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag 1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello" get bob ##> ("", aliceId, SENT $ baseId + 1) -- notification - (nonce, message) <- messageNotification apns tkn + (nonce, message) <- messageNotification (APNSMockServer apns) tkn pure (bobId, aliceId, nonce, message) Right [NotificationInfo {ntfConnId = cId, ntfMsgMeta = Just NMsgMeta {msgTs}}] <- runExceptT $ getNotificationConns alice nonce message @@ -600,7 +600,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag 2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again" get bob ##> ("", aliceId, SENT $ baseId + 2) -- no notifications should follow - noNotification alice apns + noNotification alice $ APNSMockServer apns where msgId = subtract baseId @@ -645,10 +645,10 @@ testNotificationSubscriptionNewConnection apns baseId alice bob = msgId = subtract baseId registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> APNSMockServer -> ExceptT AgentErrorType IO DeviceToken -registerTestToken a token mode apns = do +registerTestToken a token mode (APNSMockServer apns) = do let tkn = APNSDeviceToken PPApnsTest token NTRegistered <- registerNtfToken a tkn mode - Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <- + Just PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <- timeout 1000000 $ getMockNotification apns tkn verification' <- ntfData' .-> "verification" nonce' <- C.cbNonce <$> ntfData' .-> "nonce" @@ -1032,10 +1032,10 @@ testMessage_ apns a aId b bId msg = do ackMessage a bId msgId Nothing messageNotification :: HasCallStack => APNSMockServer -> DeviceToken -> ExceptT AgentErrorType IO (C.CbNonce, ByteString) -messageNotification apns tkn = do +messageNotification (APNSMockServer apns) tkn = do 500000 `timeout` getMockNotification apns tkn >>= \case Nothing -> error "no notification" - Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do + Just PushMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do nonce <- C.cbNonce <$> ntfData .-> "nonce" message <- ntfData .-> "message" pure (nonce, message) @@ -1049,14 +1049,14 @@ messageNotificationData c apns = do pure $ L.last pnMsgs noNotification :: AgentClient -> APNSMockServer -> ExceptT AgentErrorType IO () -noNotification c apns = do +noNotification c (APNSMockServer apns) = do NtfToken {deviceToken} <- getNtfTokenData c 500000 `timeout` getMockNotification apns deviceToken >>= \case Nothing -> pure () _ -> error "unexpected notification" noNotifications :: APNSMockServer -> ExceptT AgentErrorType IO () -noNotifications apns = do +noNotifications (APNSMockServer apns) = do 500000 `timeout` getAnyMockNotification apns >>= \case Nothing -> pure () _ -> error "unexpected notification" diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs index cb59b3ec6..b020899eb 100644 --- a/tests/NtfClient.hs +++ b/tests/NtfClient.hs @@ -42,7 +42,7 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost, import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding -import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse) +import Simplex.Messaging.Notifications.Protocol (DeviceToken(..), NtfResponse, WPTokenParams(..)) import Simplex.Messaging.Notifications.Server (runNtfServerBlocking) import Simplex.Messaging.Notifications.Server.Env import Simplex.Messaging.Notifications.Server.Main (getVapidKey) @@ -63,6 +63,10 @@ import UnliftIO.Async import UnliftIO.Concurrent import qualified UnliftIO.Exception as E import UnliftIO.STM +import Data.Aeson.Types ((.=)) +import qualified Network.HPACK as H +import qualified Network.HPACK.Token as H +import Data.Maybe (fromMaybe) testHost :: NonEmpty TransportHost testHost = "localhost" @@ -70,6 +74,9 @@ testHost = "localhost" apnsTestPort :: ServiceName apnsTestPort = "6010" +wpTestPort :: ServiceName +wpTestPort = "6011" + testKeyHash :: C.KeyHash testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=" @@ -224,23 +231,34 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h ntfTest :: Transport c => TProxy c 'TServer -> (THandleNTF c 'TClient -> IO ()) -> Expectation ntfTest _ test' = runNtfTest test' `shouldReturn` () -data APNSMockRequest = APNSMockRequest - { notification :: APNSNotification +data PushMockRequest a = PushMockRequest + { notification :: a } -data APNSMockResponse = APNSRespOk | APNSRespError Status Text +data PushMockResponse = PushRespOk | PushRespError Status Text -data APNSMockServer = APNSMockServer +data PushMockServer a = PushMockServer { action :: Async (), - notifications :: TM.TMap ByteString (TBQueue APNSMockRequest), + notifications :: TM.TMap ByteString (TBQueue (PushMockRequest a)), http2Server :: HTTP2Server } -apnsMockServerConfig :: HTTP2ServerConfig -apnsMockServerConfig = +data WPNotification = WPNotification + { authorization :: Maybe ByteString, + encoding :: Maybe ByteString, + ttl :: Maybe ByteString, + urgency :: Maybe ByteString, + body :: ByteString + } + +newtype APNSMockServer = APNSMockServer (PushMockServer APNSNotification) +newtype WPMockServer = WPMockServer (PushMockServer WPNotification) + +pushMockServerConfig :: ServiceName -> HTTP2ServerConfig +pushMockServerConfig port = HTTP2ServerConfig { qSize = 2, - http2Port = apnsTestPort, + http2Port = port, bufferSize = 16384, bodyHeadSize = 16384, serverSupported = http2TLSParams, @@ -254,7 +272,14 @@ apnsMockServerConfig = } withAPNSMockServer :: (APNSMockServer -> IO a) -> IO a -withAPNSMockServer = E.bracket (getAPNSMockServer apnsMockServerConfig) closeAPNSMockServer +withAPNSMockServer = E.bracket (getAPNSMockServer $ pushMockServerConfig apnsTestPort) closeAPNSMockServer + where + closeAPNSMockServer (APNSMockServer a) = closePushMockServer a + +withWPMockServer :: (WPMockServer -> IO a) -> IO a +withWPMockServer = E.bracket (getWPMockServer $ pushMockServerConfig wpTestPort) closeWPMockServer + where + closeWPMockServer (WPMockServer a) = closePushMockServer a deriving instance Generic APNSAlertBody @@ -284,36 +309,63 @@ getAPNSMockServer config@HTTP2ServerConfig {qSize} = do http2Server <- getHTTP2Server config notifications <- TM.emptyIO action <- async $ runAPNSMockServer notifications http2Server - pure APNSMockServer {action, notifications, http2Server} + pure $ APNSMockServer PushMockServer {action, notifications, http2Server} where runAPNSMockServer notifications HTTP2Server {reqQ} = forever $ do HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ let sendApnsResponse = \case - APNSRespOk -> sendResponse $ H.responseNoBody N.ok200 [] - APNSRespError status reason -> + PushRespOk -> sendResponse $ H.responseNoBody N.ok200 [] + PushRespError status reason -> sendResponse . H.responseBuilder status [] . lazyByteString $ J.encode APNSErrorResponse {reason} case J.decodeStrict' bodyHead of Just notification -> do Just token <- pure $ B.stripPrefix "/3/device/" =<< H.requestPath request q <- atomically $ TM.lookup token notifications >>= maybe (newTokenQueue token) pure - atomically $ writeTBQueue q APNSMockRequest {notification} - sendApnsResponse APNSRespOk + atomically $ writeTBQueue q PushMockRequest {notification} + sendApnsResponse PushRespOk where newTokenQueue token = newTBQueue qSize >>= \q -> TM.insert token q notifications >> pure q _ -> do putStrLn $ "runAPNSMockServer J.decodeStrict' error, reqBody: " <> show bodyHead - sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body" + sendApnsResponse $ PushRespError 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 +getWPMockServer :: HTTP2ServerConfig -> IO WPMockServer +getWPMockServer config@HTTP2ServerConfig {qSize} = do + http2Server <- getHTTP2Server config + notifications <- TM.emptyIO + action <- async $ runWPMockServer notifications http2Server + pure $ WPMockServer PushMockServer {action, notifications, http2Server} + where + runWPMockServer notifications HTTP2Server {reqQ} = forever $ do + HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ + let sendWPResponse = \case + PushRespOk -> sendResponse $ H.responseNoBody N.ok200 [] + PushRespError status reason -> + sendResponse . H.responseBuilder status [] . lazyByteString $ J.encode $ J.object [ "error" .= reason] + path = fromMaybe "/default" $ H.requestPath request + (_, headers) = H.requestHeaders request + authorization = H.getHeaderValue H.tokenAuthorization headers + encoding = H.getHeaderValue H.tokenContentEncoding headers + ttl = H.getHeaderValue (H.toToken "TTL") headers + urgency = H.getHeaderValue (H.toToken "urgency") headers + notification = WPNotification {body = bodyHead, authorization, encoding, ttl, urgency} + q <- atomically $ TM.lookup path notifications >>= maybe (newTokenQueue path) pure + atomically $ writeTBQueue q PushMockRequest {notification} + sendWPResponse PushRespOk + where + newTokenQueue path = newTBQueue qSize >>= \q -> TM.insert path q notifications >> pure q + +getMockNotification :: MonadIO m => PushMockServer a -> DeviceToken -> m (PushMockRequest a) +getMockNotification PushMockServer {notifications} (WPDeviceToken _ (WPTokenParams path _)) = do + atomically $ TM.lookup path notifications >>= maybe retry readTBQueue +getMockNotification PushMockServer {notifications} (APNSDeviceToken _ token) = do atomically $ TM.lookup token notifications >>= maybe retry readTBQueue -getAnyMockNotification :: MonadIO m => APNSMockServer -> m APNSMockRequest -getAnyMockNotification APNSMockServer {notifications} = do +getAnyMockNotification :: MonadIO m => PushMockServer a -> m (PushMockRequest a) +getAnyMockNotification PushMockServer {notifications} = do atomically $ readTVar notifications >>= mapM readTBQueue . M.elems >>= \case [] -> retry; ntf : _ -> pure ntf -closeAPNSMockServer :: APNSMockServer -> IO () -closeAPNSMockServer APNSMockServer {action, http2Server} = do +closePushMockServer :: PushMockServer a -> IO () +closePushMockServer PushMockServer {action, http2Server} = do closeHTTP2Server http2Server uninterruptibleCancel action diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs index c4dd72b24..33154cbe0 100644 --- a/tests/NtfServerTests.hs +++ b/tests/NtfServerTests.hs @@ -48,11 +48,14 @@ import Simplex.Messaging.Transport import Test.Hspec hiding (fit, it) import UnliftIO.STM import Util +import Simplex.Messaging.Encoding.String (StrEncoding(..)) +import System.Environment (setEnv) ntfServerTests :: (ASrvTransport, AStoreType) -> Spec ntfServerTests ps@(t, _) = do describe "Notifications server protocol syntax" $ ntfSyntaxTests t - describe "Notification subscriptions (NKEY)" $ testNotificationSubscription ps createNtfQueueNKEY + describe "APNS notification subscriptions (NKEY)" $ testAPNSNotificationSubscription ps createNtfQueueNKEY + describe "WP notification subscriptions (NKEY)" $ testWPNotificationSubscription ps createNtfQueueNKEY -- describe "Notification subscriptions (NEW with ntf creds)" $ testNotificationSubscription ps createNtfQueueNEW describe "Retried notification subscription" $ testRetriedNtfSubscription ps @@ -99,22 +102,22 @@ v .-> key = let J.Object o = v in U.decodeLenient . encodeUtf8 <$> JT.parseEither (J..: key) o -testNotificationSubscription :: (ASrvTransport, AStoreType) -> CreateQueueFunc -> Spec -testNotificationSubscription (ATransport t, msType) createQueue = - it "should create notification subscription and notify when message is received" $ do +testAPNSNotificationSubscription :: (ASrvTransport, AStoreType) -> CreateQueueFunc -> Spec +testAPNSNotificationSubscription (ATransport t, msType) createQueue = + it "should create APNS notification subscription and notify when message is received" $ do g <- C.newRandom (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g let tkn = APNSDeviceToken PPApnsTest "abcd" - withAPNSMockServer $ \apns -> + withAPNSMockServer $ \(APNSMockServer apns) -> smpTest2 t msType $ \rh sh -> ntfTest t $ \nh -> do ((sId, rId, rKey, rcvDhSecret), nId, rcvNtfDhSecret) <- createQueue rh sPub nPub -- register and verify token RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub) - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn let dhSecret = C.dh' ntfDh dhPriv decryptCode nd = @@ -127,7 +130,7 @@ testNotificationSubscription (ATransport t, msType) createQueue = RespNtf "1a" NoEntity (NRTknId tId1 ntfDh1) <- signSendRecvNtf nh tknKey ("1a", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub) tId1 `shouldBe` tId ntfDh1 `shouldBe` ntfDh - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData1}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData1}} <- getMockNotification apns tkn let code1 = decryptCode ntfData1 code `shouldBe` code1 @@ -141,7 +144,7 @@ testNotificationSubscription (ATransport t, msType) createQueue = threadDelay 50000 Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello") -- receive notification - APNSMockRequest {notification} <- getMockNotification apns tkn + PushMockRequest {notification} <- getMockNotification apns tkn let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData'} = notification Right nonce' = C.cbNonce <$> ntfData' .-> "nonce" Right message = ntfData' .-> "message" @@ -163,7 +166,7 @@ testNotificationSubscription (ATransport t, msType) createQueue = let tkn' = APNSDeviceToken PPApnsTest "efgh" RespNtf "7" tId' NROk <- signSendRecvNtf nh tknKey ("7", tId, TRPL tkn') tId `shouldBe` tId' - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <- getMockNotification apns tkn' let Right verification2 = ntfData2 .-> "verification" Right nonce2 = C.cbNonce <$> ntfData2 .-> "nonce" @@ -172,7 +175,7 @@ testNotificationSubscription (ATransport t, msType) createQueue = RespNtf "8a" _ (NRTkn NTActive) <- signSendRecvNtf nh tknKey ("8a", tId, TCHK) -- send message Resp "9" _ OK <- signSendRecv sh sKey ("9", sId, _SEND' "hello 2") - APNSMockRequest {notification = notification3} <- getMockNotification apns tkn' + PushMockRequest {notification = notification3} <- getMockNotification apns tkn' let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData3} = notification3 Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce" Right message3 = ntfData3 .-> "message" @@ -182,6 +185,32 @@ testNotificationSubscription (ATransport t, msType) createQueue = smpServer3 `shouldBe` srv notifierId3 `shouldBe` nId +testWPNotificationSubscription :: (ASrvTransport, AStoreType) -> CreateQueueFunc -> Spec +testWPNotificationSubscription (ATransport t, msType) createQueue = + it "should create WP notification subscription and notify when message is received" $ do + g <- C.newRandom + (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g + let params ::WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM" + tkn = WPDeviceToken (WPP $ WPSrvLoc $ SrvLoc "localhost" wpTestPort) params + _ <- setEnv "SYSTEM_CERTIFICATE_PATH" "tests/fixtures/" + withWPMockServer $ \(WPMockServer wp) -> + smpTest2 t msType $ \rh sh -> + ntfTest t $ \nh -> do + ((sId, rId, rKey, rcvDhSecret), nId, rcvNtfDhSecret) <- createQueue rh sPub nPub + -- register and verify token + RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub) + PushMockRequest {notification = WPNotification {authorization, encoding, ttl, urgency, body}} <- + getMockNotification wp tkn + encoding `shouldBe` Just "aes128gcm" + ttl `shouldBe` Just "2592000" + urgency `shouldBe` Just "high" + -- TODO: uncomment when vapid is merged + -- authorization `shouldContainBS` "vapid t=" + + testRetriedNtfSubscription :: (ASrvTransport, AStoreType) -> Spec testRetriedNtfSubscription (ATransport t, msType) = it "should allow retrying to create notification subscription with the same token and key" $ do @@ -233,13 +262,13 @@ createNtfQueueNKEY h sPub nPub = do pure ((sId, rId, rKey, rcvDhSecret), nId, rcvNtfDhSecret) registerToken :: Transport c => THandleNTF c 'TClient -> APNSMockServer -> ByteString -> IO (C.APrivateAuthKey, C.DhSecretX25519, NtfEntityId, NtfRegCode) -registerToken nh apns token = do +registerToken nh (APNSMockServer apns) token = do g <- C.newRandom (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g let tkn = APNSDeviceToken PPApnsTest token RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub) - APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- + PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <- getMockNotification apns tkn let dhSecret = C.dh' ntfDh dhPriv decryptCode nd = From 8129eb6cc84701c8c8f3e1aa06c5d0f2e0a286b7 Mon Sep 17 00:00:00 2001 From: sim Date: Mon, 17 Nov 2025 17:47:44 +0100 Subject: [PATCH 2/4] Add HTTP2 support to webpush --- simplexmq.cabal | 1 + .../Messaging/Notifications/Server/Env.hs | 14 ++-- .../Notifications/Server/Push/WebPush.hs | 64 +++++++++++++++---- tests/NtfServerTests.hs | 3 +- 4 files changed, 63 insertions(+), 19 deletions(-) diff --git a/simplexmq.cabal b/simplexmq.cabal index d72d3f02c..ea8257669 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -305,6 +305,7 @@ library , containers ==0.6.* , crypton ==0.34.* , crypton-x509 ==1.7.* + , crypton-x509-system ==1.6.* , crypton-x509-store ==1.6.* , crypton-x509-validation ==1.6.* , cryptostore ==0.3.* diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index 83f999461..2721c2a1f 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -30,20 +30,21 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Notifications.Protocol import Simplex.Messaging.Notifications.Server.Push import Simplex.Messaging.Notifications.Server.Push.APNS -import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushClient (..), WebPushConfig, wpPushProviderClient) +import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushClient (..), WebPushConfig, wpPushProviderClientH1, wpPushProviderClientH2, wpHTTP2Client) import Simplex.Messaging.Notifications.Server.Stats import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore) import Simplex.Messaging.Notifications.Server.Store.Postgres import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Notifications.Server.StoreLog (readWriteNtfSTMStore) import Simplex.Messaging.Notifications.Transport (NTFVersion, VersionRangeNTF) -import Simplex.Messaging.Protocol (BasicAuth, CorrId, Party (..), SMPServer, SParty (..), Transmission) +import Simplex.Messaging.Protocol (BasicAuth, CorrId, Party (..), SMPServer, SParty (..), Transmission, SrvLoc (..)) import Simplex.Messaging.Server.Env.STM (StartOptions (..)) import Simplex.Messaging.Server.Expiration import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..)) import Simplex.Messaging.Server.StoreLog (closeStoreLog) import Simplex.Messaging.Session import Simplex.Messaging.TMap (TMap) +import Simplex.Messaging.Util (tshow) import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Transport (ASrvTransport, SMPServiceRole (..), ServiceCredentials (..), THandleParams, TransportPeer (..)) import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, TransportServerConfig, loadFingerprint, loadServerCredential) @@ -180,14 +181,19 @@ newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient -newWPPushClient NtfPushServer {wpConfig, pushClients} pp = do +newWPPushClient NtfPushServer {wpConfig, pushClients} (WPP (WPSrvLoc (SrvLoc h p))) = do logDebug "New WP Client requested" -- We use one http manager per push server (which may be used by different clients) manager <- wpHTTPManager cache <- newIORef Nothing random <- C.newRandom let client = WebPushClient {wpConfig, cache, manager, random} - pure $ wpPushProviderClient client + r <- wpHTTP2Client h p + case r of + Right client -> pure $ wpPushProviderClientH2 client + Left e -> do + logError $ "Error connecting to H2 WP: " <> tshow e + wpPushProviderClientH1 client wpHTTPManager :: IO Manager wpHTTPManager = diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index d6a656d86..060c65142 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -38,10 +38,17 @@ import Data.Time.Clock.System (getSystemTime, systemSeconds) import Network.HTTP.Client import qualified Network.HTTP.Types as N import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfRegCode (..), WPAuth (..), WPKey (..), WPP256dh (..), WPTokenParams (..), encodePNMessages, wpAud, wpRequest) +import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfRegCode (..), WPAuth (..), WPKey (..), WPP256dh (..), WPTokenParams (..), WPProvider (..), encodePNMessages, wpAud, wpRequest) import Simplex.Messaging.Notifications.Server.Push import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Util (liftError', safeDecodeUtf8, tshow) +import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, getHTTP2Client, defaultHTTP2ClientConfig, HTTP2ClientError, sendRequest) +import Network.Socket (ServiceName, HostName) +import System.X509.Unix +import qualified Network.HTTP2.Client as H +import Data.ByteString.Builder (lazyByteString) +import Simplex.Messaging.Encoding.String (StrEncoding(..)) +import Data.Bifunctor (first) import UnliftIO.STM -- | Vapid @@ -61,7 +68,6 @@ mkVapid key = VapidKey {key, fp} data WebPushClient = WebPushClient { wpConfig :: WebPushConfig, cache :: IORef (Maybe WPCache), - manager :: Manager, random :: TVar ChaChaDRG } @@ -132,26 +138,56 @@ mkVapidHeader VapidKey {key, fp} uriAuthority expire = do signedToken <- signedJWTTokenRaw key jwt pure $ "vapid t=" <> signedToken <> ",k=" <> fp -wpPushProviderClient :: WebPushClient -> PushProviderClient -wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher -wpPushProviderClient c@WebPushClient {wpConfig, cache, manager} tkn@NtfTknRec {token = token@(WPDeviceToken pp params)} pn = do +wpHTTP2Client :: HostName -> ServiceName -> IO (Either HTTP2ClientError HTTP2Client) +wpHTTP2Client h p = do + caStore <- Just <$> getSystemCertificateStore + let config = defaultHTTP2ClientConfig + getHTTP2Client h p caStore config nop + where + nop = pure () + +wpHeaders :: B.ByteString -> [N.Header] +wpHeaders vapidH = [ + -- Why http2-client doesn't accept TTL AND Urgency? + -- Keeping Urgency for now, the TTL should be around 30 days by default on the push servers + -- ("TTL", "2592000"), -- 30 days + ("Urgency", "high"), + ("Content-Encoding", "aes128gcm"), + ("Authorization", vapidH) + -- TODO: topic for pings and interval + ] + +wpHTTP2Req :: B.ByteString -> [(N.HeaderName, B.ByteString)] -> LB.ByteString -> H.Request +wpHTTP2Req path headers s = H.requestBuilder N.methodPost path headers (lazyByteString s) + +wpPushProviderClientH2 :: WebPushClient -> HTTP2Client -> PushProviderClient +wpPushProviderClientH2 _ _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher +wpPushProviderClientH2 c@WebPushClient {wpConfig, cache} http2 tkn@NtfTknRec {token = (WPDeviceToken pp@(WPP p) params)} pn = do + -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams) + -- parsing will happen in DeviceToken parser, so it won't fail here + encBody <- body + vapidH <- liftError' toPPWPError $ try $ getVapidHeader (vapidKey wpConfig) cache $ wpAud pp + let req = wpHTTP2Req (wpPath params) (wpHeaders vapidH) $ LB.fromStrict encBody + logDebug $ "HTTP/2 Request to " <> tshow (strEncode p) + void $ liftHTTPS2 $ sendRequest http2 req Nothing + where + body :: ExceptT PushProviderError IO B.ByteString + body = withExceptT PPCryptoError $ wpEncrypt c tkn params pn + liftHTTPS2 a = ExceptT $ first PPConnection <$> a + +wpPushProviderClientH1 :: WebPushClient -> Manager -> PushProviderClient +wpPushProviderClientH1 _ _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher +wpPushProviderClientH1 c@WebPushClient {wpConfig, cache} manager tkn@NtfTknRec {token = token@(WPDeviceToken pp params)} pn = do -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams) -- parsing will happen in DeviceToken parser, so it won't fail here r <- wpRequest token vapidH <- liftError' toPPWPError $ try $ getVapidHeader (vapidKey wpConfig) cache $ wpAud pp logDebug $ "Web Push request to " <> tshow (host r) encBody <- withExceptT PPCryptoError $ wpEncrypt c tkn params pn - let requestHeaders = - [ ("TTL", "2592000"), -- 30 days - ("Urgency", "high"), - ("Content-Encoding", "aes128gcm"), - ("Authorization", vapidH) - -- TODO: topic for pings and interval - ] - req = + let req = r { method = "POST", - requestHeaders, + requestHeaders = wpHeaders vapidH, requestBody = RequestBodyBS encBody, redirectCount = 0 } diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs index 33154cbe0..4aab1845e 100644 --- a/tests/NtfServerTests.hs +++ b/tests/NtfServerTests.hs @@ -205,7 +205,8 @@ testWPNotificationSubscription (ATransport t, msType) createQueue = PushMockRequest {notification = WPNotification {authorization, encoding, ttl, urgency, body}} <- getMockNotification wp tkn encoding `shouldBe` Just "aes128gcm" - ttl `shouldBe` Just "2592000" + -- We can't pass TTL and Urgency ATM + -- ttl `shouldBe` Just "2592000" urgency `shouldBe` Just "high" -- TODO: uncomment when vapid is merged -- authorization `shouldContainBS` "vapid t=" From afd001150b1ca195d3d1e7d495390f289f087c04 Mon Sep 17 00:00:00 2001 From: sim Date: Tue, 18 Nov 2025 08:27:09 +0100 Subject: [PATCH 3/4] Parse webpush http2 response status --- .../Notifications/Server/Push/WebPush.hs | 33 +++++++++++-------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index 060c65142..55a6ad46e 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -42,10 +42,10 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfRegCode (. import Simplex.Messaging.Notifications.Server.Push import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Util (liftError', safeDecodeUtf8, tshow) -import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, getHTTP2Client, defaultHTTP2ClientConfig, HTTP2ClientError, sendRequest) +import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, getHTTP2Client, defaultHTTP2ClientConfig, HTTP2ClientError, sendRequest, HTTP2Response (..)) import Network.Socket (ServiceName, HostName) import System.X509.Unix -import qualified Network.HTTP2.Client as H +import qualified Network.HTTP2.Client as H2 import Data.ByteString.Builder (lazyByteString) import Simplex.Messaging.Encoding.String (StrEncoding(..)) import Data.Bifunctor (first) @@ -157,8 +157,8 @@ wpHeaders vapidH = [ -- TODO: topic for pings and interval ] -wpHTTP2Req :: B.ByteString -> [(N.HeaderName, B.ByteString)] -> LB.ByteString -> H.Request -wpHTTP2Req path headers s = H.requestBuilder N.methodPost path headers (lazyByteString s) +wpHTTP2Req :: B.ByteString -> [(N.HeaderName, B.ByteString)] -> LB.ByteString -> H2.Request +wpHTTP2Req path headers s = H2.requestBuilder N.methodPost path headers (lazyByteString s) wpPushProviderClientH2 :: WebPushClient -> HTTP2Client -> PushProviderClient wpPushProviderClientH2 _ _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher @@ -169,7 +169,11 @@ wpPushProviderClientH2 c@WebPushClient {wpConfig, cache} http2 tkn@NtfTknRec {to vapidH <- liftError' toPPWPError $ try $ getVapidHeader (vapidKey wpConfig) cache $ wpAud pp let req = wpHTTP2Req (wpPath params) (wpHeaders vapidH) $ LB.fromStrict encBody logDebug $ "HTTP/2 Request to " <> tshow (strEncode p) - void $ liftHTTPS2 $ sendRequest http2 req Nothing + HTTP2Response {response} <- liftHTTPS2 $ sendRequest http2 req Nothing + let status = H2.responseStatus response + if status >= Just N.ok200 && status < Just N.status300 + then pure () + else throwError $ fromStatusCode status where body :: ExceptT PushProviderError IO B.ByteString body = withExceptT PPCryptoError $ wpEncrypt c tkn params pn @@ -249,13 +253,14 @@ wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do toPPWPError :: SomeException -> PushProviderError toPPWPError e = case fromException e of Just (InvalidUrlException _ _) -> PPWPInvalidUrl - Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (responseStatus resp) ("" :: String) + Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (Just $ responseStatus resp) _ -> PPWPOtherError e - where - fromStatusCode status reason - | status == N.status200 = PPWPRemovedEndpoint - | status == N.status410 = PPWPRemovedEndpoint - | status == N.status413 = PPWPRequestTooLong - | status == N.status429 = PPRetryLater - | status >= N.status500 = PPRetryLater - | otherwise = PPResponseError (Just status) (tshow reason) + +fromStatusCode :: Maybe N.Status -> PushProviderError +fromStatusCode status + | status == Just N.status404 = PPWPRemovedEndpoint + | status == Just N.status410 = PPWPRemovedEndpoint + | status == Just N.status413 = PPWPRequestTooLong + | status == Just N.status429 = PPRetryLater + | status >= Just N.status500 = PPRetryLater + | otherwise = PPResponseError status "Invalid response" From 5b56bdff2d53c7670d4df8a37ee8ef7e24db7b46 Mon Sep 17 00:00:00 2001 From: sim Date: Tue, 20 Jan 2026 17:20:45 +0100 Subject: [PATCH 4/4] Fix following rebase --- src/Simplex/Messaging/Notifications/Server/Env.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index 2721c2a1f..b71ffd0ec 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -184,16 +184,15 @@ newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient newWPPushClient NtfPushServer {wpConfig, pushClients} (WPP (WPSrvLoc (SrvLoc h p))) = do logDebug "New WP Client requested" -- We use one http manager per push server (which may be used by different clients) - manager <- wpHTTPManager cache <- newIORef Nothing random <- C.newRandom - let client = WebPushClient {wpConfig, cache, manager, random} + let client = WebPushClient {wpConfig, cache, random} r <- wpHTTP2Client h p case r of - Right client -> pure $ wpPushProviderClientH2 client + Right h2Client -> pure $ wpPushProviderClientH2 client h2Client Left e -> do logError $ "Error connecting to H2 WP: " <> tshow e - wpPushProviderClientH1 client + wpPushProviderClientH1 client <$> wpHTTPManager wpHTTPManager :: IO Manager wpHTTPManager =