From 87c9b2abbcce0888b2012e7f02c5b889a516438c Mon Sep 17 00:00:00 2001 From: Paul Bottinelli Date: Thu, 4 Jun 2026 15:15:27 -0400 Subject: [PATCH 1/4] Disable APNS test provider in production --- src/Simplex/Messaging/Notifications/Server.hs | 79 ++++++++++++------- .../Messaging/Notifications/Server/Env.hs | 1 + .../Messaging/Notifications/Server/Main.hs | 1 + tests/NtfClient.hs | 1 + tests/NtfServerTests.hs | 15 ++++ 5 files changed, 67 insertions(+), 30 deletions(-) diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index 02429e9108..704026b3ec 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -640,9 +640,19 @@ showServer' :: SMPServer -> Text showServer' = decodeLatin1 . strEncode . host pushNotification :: NtfPushServer -> Maybe T.Text -> OwnServer -> NtfTknRec -> PushNotification -> M () -pushNotification s srvHost_ isOwn tkn@NtfTknRec {token = DeviceToken pp _} ntf = do - q <- getOrCreatePushWorker s (srvHost_, pp) isOwn - atomically $ writeTBQueue q (tkn, ntf) +pushNotification s srvHost_ isOwn tkn@NtfTknRec {token = token@(DeviceToken pp _)} ntf = + pushProviderAllowed token >>= \case + True -> do + q <- getOrCreatePushWorker s (srvHost_, pp) isOwn + atomically $ writeTBQueue q (tkn, ntf) + False -> liftIO $ logWarn "skipping disabled APNS test push provider" + +pushProviderAllowed :: DeviceToken -> M Bool +pushProviderAllowed (DeviceToken PPApnsTest _) = asks (allowTestPushProvider . config) +pushProviderAllowed _ = pure True + +disabledPushProvider :: M NtfResponse +disabledPushProvider = pure $ NRErr $ CMD SMP.PROHIBITED getOrCreatePushWorker :: NtfPushServer -> (Maybe T.Text, PushProvider) -> OwnServer -> M (TBQueue (NtfTknRec, PushNotification)) getOrCreatePushWorker s@NtfPushServer {pushWorkers, pushWorkerSeq, pushQSize} key@(srvHost_, _) isOwn = do @@ -835,28 +845,34 @@ client NtfServerClient {rcvQ, sndQ} ns@NtfSubscriber {smpAgent = ca} ps = processCommand :: NtfRequest -> M (Transmission NtfResponse) processCommand = \case NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn token _ dhPubKey)) -> (corrId,NoEntity,) <$> do - logDebug "TNEW - new token" - (srvDhPubKey, srvDhPrivKey) <- atomically . C.generateKeyPair =<< asks random - let dhSecret = C.dh' dhPubKey srvDhPrivKey - tknId <- getId - regCode <- getRegCode - ts <- liftIO $ getSystemDate - let tkn = mkNtfTknRec tknId newTkn srvDhPrivKey dhSecret regCode ts - withNtfStore (`addNtfToken` tkn) $ \_ -> do - pushNotification ps Nothing False tkn $ PNVerification regCode - incNtfStatT token ntfVrfQueued - incNtfStatT token tknCreated - pure $ NRTknId tknId srvDhPubKey + pushProviderAllowed token >>= \case + False -> disabledPushProvider + True -> do + logDebug "TNEW - new token" + (srvDhPubKey, srvDhPrivKey) <- atomically . C.generateKeyPair =<< asks random + let dhSecret = C.dh' dhPubKey srvDhPrivKey + tknId <- getId + regCode <- getRegCode + ts <- liftIO $ getSystemDate + let tkn = mkNtfTknRec tknId newTkn srvDhPrivKey dhSecret regCode ts + withNtfStore (`addNtfToken` tkn) $ \_ -> do + pushNotification ps Nothing False tkn $ PNVerification regCode + incNtfStatT token ntfVrfQueued + incNtfStatT token tknCreated + pure $ NRTknId tknId srvDhPubKey NtfReqCmd SToken (NtfTkn tkn@NtfTknRec {token, ntfTknId, tknStatus, tknRegCode, tknDhSecret, tknDhPrivKey}) (corrId, tknId, cmd) -> do (corrId,tknId,) <$> case cmd of TNEW (NewNtfTkn _ _ dhPubKey) -> do - logDebug "TNEW - registered token" - let dhSecret = C.dh' dhPubKey tknDhPrivKey - -- it is required that DH secret is the same, to avoid failed verifications if notification is delaying - if - | tknDhSecret /= dhSecret -> pure $ NRErr AUTH - | allowTokenVerification tknStatus -> sendVerification - | otherwise -> withNtfStore (\st -> updateTknStatus st tkn NTRegistered) $ \_ -> sendVerification + pushProviderAllowed token >>= \case + False -> disabledPushProvider + True -> do + logDebug "TNEW - registered token" + let dhSecret = C.dh' dhPubKey tknDhPrivKey + -- it is required that DH secret is the same, to avoid failed verifications if notification is delaying + if + | tknDhSecret /= dhSecret -> pure $ NRErr AUTH + | allowTokenVerification tknStatus -> sendVerification + | otherwise -> withNtfStore (\st -> updateTknStatus st tkn NTRegistered) $ \_ -> sendVerification where sendVerification = do pushNotification ps Nothing False tkn $ PNVerification tknRegCode @@ -873,14 +889,17 @@ client NtfServerClient {rcvQ, sndQ} ns@NtfSubscriber {smpAgent = ca} ps = logDebug "TCHK" pure $ NRTkn tknStatus TRPL token' -> do - logDebug "TRPL - replace token" - regCode <- getRegCode - let tkn' = tkn {token = token', tknStatus = NTRegistered, tknRegCode = regCode} - withNtfStore (`replaceNtfToken` tkn') $ \_ -> do - pushNotification ps Nothing False tkn' $ PNVerification regCode - incNtfStatT token ntfVrfQueued - incNtfStatT token tknReplaced - pure NROk + pushProviderAllowed token' >>= \case + False -> disabledPushProvider + True -> do + logDebug "TRPL - replace token" + regCode <- getRegCode + let tkn' = tkn {token = token', tknStatus = NTRegistered, tknRegCode = regCode} + withNtfStore (`replaceNtfToken` tkn') $ \_ -> do + pushNotification ps Nothing False tkn' $ PNVerification regCode + incNtfStatT token ntfVrfQueued + incNtfStatT token tknReplaced + pure NROk TDEL -> do logDebug "TDEL" withNtfStore (`deleteNtfToken` tknId) $ \ss -> do diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index 365d464c85..6f9416db40 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -81,6 +81,7 @@ data NtfServerConfig = NtfServerConfig pushQSize :: Natural, smpAgentCfg :: SMPClientAgentConfig, apnsConfig :: APNSPushClientConfig, + allowTestPushProvider :: Bool, subsBatchSize :: Int, inactiveClientExpiration :: Maybe ExpirationConfig, dbStoreConfig :: PostgresStoreCfg, diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs index cba3bddd9c..d1fd2496d4 100644 --- a/src/Simplex/Messaging/Notifications/Server/Main.hs +++ b/src/Simplex/Messaging/Notifications/Server/Main.hs @@ -193,6 +193,7 @@ ntfServerCLI cfgPath logPath = persistErrorInterval = 0 -- seconds }, apnsConfig = defaultAPNSPushClientConfig, + allowTestPushProvider = False, subsBatchSize = 900, inactiveClientExpiration = settingIsOn "INACTIVE_CLIENTS" "disconnect" ini diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs index d7b72b766f..9835e1cdd8 100644 --- a/tests/NtfClient.hs +++ b/tests/NtfClient.hs @@ -141,6 +141,7 @@ ntfServerCfg = { apnsPort = apnsTestPort, caStoreFile = "tests/fixtures/ca.crt" }, + allowTestPushProvider = True, subsBatchSize = 900, inactiveClientExpiration = Just defaultInactiveClientExpiration, dbStoreConfig = ntfTestDBCfg, diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs index 5a44574d13..5257cabbf8 100644 --- a/tests/NtfServerTests.hs +++ b/tests/NtfServerTests.hs @@ -52,6 +52,8 @@ import Util ntfServerTests :: (ASrvTransport, AStoreType) -> Spec ntfServerTests ps@(t, _) = do describe "Notifications server protocol syntax" $ ntfSyntaxTests t + describe "Push provider policy" $ do + it "rejects APNS test provider unless enabled" $ testApnsTestProviderRejected t describe "Notification subscriptions (NKEY)" $ testNotificationSubscription ps createNtfQueueNKEY describe "Notification subscriptions (NEW with ntf creds)" $ testNotificationSubscription ps createNtfQueueNEW describe "Retried notification subscription" $ testRetriedNtfSubscription ps @@ -72,6 +74,19 @@ ntfSyntaxTests (ATransport t) = do Expectation command >#> response = withAPNSMockServer $ \_ -> ntfServerTest t command `shouldReturn` response +testApnsTestProviderRejected :: ASrvTransport -> Expectation +testApnsTestProviderRejected (ATransport t) = do + g <- C.newRandom + (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g + let tkn = DeviceToken PPApnsTest "abcd" + cfg = ntfServerCfg {allowTestPushProvider = False, transports = [(ntfTestPort, ATransport t, False)]} + withNtfServerCfg cfg $ \_ -> + testNtfClient $ \nh -> do + RespNtf "1" NoEntity (NRErr (CMD PROHIBITED)) <- + signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub) + pure () + pattern RespNtf :: CorrId -> QueueId -> NtfResponse -> Transmission (Either ErrorType NtfResponse) pattern RespNtf corrId queueId command <- (corrId, queueId, Right command) From 9aec52ab505e47c5134809f2c9c8cfadb9dad922 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 15 Jun 2026 11:27:09 +0000 Subject: [PATCH 2/4] refactor(ntf): extract guardPushProvider for test-provider guard --- src/Simplex/Messaging/Notifications/Server.hs | 76 +++++++++---------- 1 file changed, 35 insertions(+), 41 deletions(-) diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index 704026b3ec..f50775d2fe 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -651,8 +651,11 @@ pushProviderAllowed :: DeviceToken -> M Bool pushProviderAllowed (DeviceToken PPApnsTest _) = asks (allowTestPushProvider . config) pushProviderAllowed _ = pure True -disabledPushProvider :: M NtfResponse -disabledPushProvider = pure $ NRErr $ CMD SMP.PROHIBITED +guardPushProvider :: DeviceToken -> M NtfResponse -> M NtfResponse +guardPushProvider token action = + pushProviderAllowed token >>= \case + True -> action + False -> pure $ NRErr $ CMD SMP.PROHIBITED getOrCreatePushWorker :: NtfPushServer -> (Maybe T.Text, PushProvider) -> OwnServer -> M (TBQueue (NtfTknRec, PushNotification)) getOrCreatePushWorker s@NtfPushServer {pushWorkers, pushWorkerSeq, pushQSize} key@(srvHost_, _) isOwn = do @@ -844,35 +847,29 @@ client NtfServerClient {rcvQ, sndQ} ns@NtfSubscriber {smpAgent = ca} ps = where processCommand :: NtfRequest -> M (Transmission NtfResponse) processCommand = \case - NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn token _ dhPubKey)) -> (corrId,NoEntity,) <$> do - pushProviderAllowed token >>= \case - False -> disabledPushProvider - True -> do - logDebug "TNEW - new token" - (srvDhPubKey, srvDhPrivKey) <- atomically . C.generateKeyPair =<< asks random - let dhSecret = C.dh' dhPubKey srvDhPrivKey - tknId <- getId - regCode <- getRegCode - ts <- liftIO $ getSystemDate - let tkn = mkNtfTknRec tknId newTkn srvDhPrivKey dhSecret regCode ts - withNtfStore (`addNtfToken` tkn) $ \_ -> do - pushNotification ps Nothing False tkn $ PNVerification regCode - incNtfStatT token ntfVrfQueued - incNtfStatT token tknCreated - pure $ NRTknId tknId srvDhPubKey + NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn token _ dhPubKey)) -> (corrId,NoEntity,) <$> guardPushProvider token (do + logDebug "TNEW - new token" + (srvDhPubKey, srvDhPrivKey) <- atomically . C.generateKeyPair =<< asks random + let dhSecret = C.dh' dhPubKey srvDhPrivKey + tknId <- getId + regCode <- getRegCode + ts <- liftIO $ getSystemDate + let tkn = mkNtfTknRec tknId newTkn srvDhPrivKey dhSecret regCode ts + withNtfStore (`addNtfToken` tkn) $ \_ -> do + pushNotification ps Nothing False tkn $ PNVerification regCode + incNtfStatT token ntfVrfQueued + incNtfStatT token tknCreated + pure $ NRTknId tknId srvDhPubKey) NtfReqCmd SToken (NtfTkn tkn@NtfTknRec {token, ntfTknId, tknStatus, tknRegCode, tknDhSecret, tknDhPrivKey}) (corrId, tknId, cmd) -> do (corrId,tknId,) <$> case cmd of - TNEW (NewNtfTkn _ _ dhPubKey) -> do - pushProviderAllowed token >>= \case - False -> disabledPushProvider - True -> do - logDebug "TNEW - registered token" - let dhSecret = C.dh' dhPubKey tknDhPrivKey - -- it is required that DH secret is the same, to avoid failed verifications if notification is delaying - if - | tknDhSecret /= dhSecret -> pure $ NRErr AUTH - | allowTokenVerification tknStatus -> sendVerification - | otherwise -> withNtfStore (\st -> updateTknStatus st tkn NTRegistered) $ \_ -> sendVerification + TNEW (NewNtfTkn _ _ dhPubKey) -> guardPushProvider token $ do + logDebug "TNEW - registered token" + let dhSecret = C.dh' dhPubKey tknDhPrivKey + -- it is required that DH secret is the same, to avoid failed verifications if notification is delaying + if + | tknDhSecret /= dhSecret -> pure $ NRErr AUTH + | allowTokenVerification tknStatus -> sendVerification + | otherwise -> withNtfStore (\st -> updateTknStatus st tkn NTRegistered) $ \_ -> sendVerification where sendVerification = do pushNotification ps Nothing False tkn $ PNVerification tknRegCode @@ -888,18 +885,15 @@ client NtfServerClient {rcvQ, sndQ} ns@NtfSubscriber {smpAgent = ca} ps = TCHK -> do logDebug "TCHK" pure $ NRTkn tknStatus - TRPL token' -> do - pushProviderAllowed token' >>= \case - False -> disabledPushProvider - True -> do - logDebug "TRPL - replace token" - regCode <- getRegCode - let tkn' = tkn {token = token', tknStatus = NTRegistered, tknRegCode = regCode} - withNtfStore (`replaceNtfToken` tkn') $ \_ -> do - pushNotification ps Nothing False tkn' $ PNVerification regCode - incNtfStatT token ntfVrfQueued - incNtfStatT token tknReplaced - pure NROk + TRPL token' -> guardPushProvider token' $ do + logDebug "TRPL - replace token" + regCode <- getRegCode + let tkn' = tkn {token = token', tknStatus = NTRegistered, tknRegCode = regCode} + withNtfStore (`replaceNtfToken` tkn') $ \_ -> do + pushNotification ps Nothing False tkn' $ PNVerification regCode + incNtfStatT token ntfVrfQueued + incNtfStatT token tknReplaced + pure NROk TDEL -> do logDebug "TDEL" withNtfStore (`deleteNtfToken` tknId) $ \ss -> do From 462470c6d883a61e39f4d07705624a8e2a670798 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 15 Jun 2026 11:27:09 +0000 Subject: [PATCH 3/4] test(ntf): fix APNS test provider test compilation --- tests/NtfServerTests.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs index 5257cabbf8..7fd430fefa 100644 --- a/tests/NtfServerTests.hs +++ b/tests/NtfServerTests.hs @@ -39,6 +39,7 @@ import qualified Simplex.Messaging.Agent.Protocol as AP import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding import Simplex.Messaging.Notifications.Protocol +import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..)) import Simplex.Messaging.Notifications.Server.Push.APNS import Simplex.Messaging.Notifications.Transport (THandleNTF) import Simplex.Messaging.Parsers (parse, parseAll) @@ -75,14 +76,14 @@ ntfSyntaxTests (ATransport t) = do command >#> response = withAPNSMockServer $ \_ -> ntfServerTest t command `shouldReturn` response testApnsTestProviderRejected :: ASrvTransport -> Expectation -testApnsTestProviderRejected (ATransport t) = do +testApnsTestProviderRejected (ATransport (t :: TProxy c 'TServer)) = do g <- C.newRandom (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g let tkn = DeviceToken PPApnsTest "abcd" - cfg = ntfServerCfg {allowTestPushProvider = False, transports = [(ntfTestPort, ATransport t, False)]} - withNtfServerCfg cfg $ \_ -> - testNtfClient $ \nh -> do + ntfCfg = ntfServerCfg {allowTestPushProvider = False, transports = [(ntfTestPort, ATransport t, False)]} + withNtfServerCfg ntfCfg $ \_ -> + testNtfClient $ \(nh :: THandleNTF c 'TClient) -> do RespNtf "1" NoEntity (NRErr (CMD PROHIBITED)) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub) pure () From 15e50c3631b745209cc8ff18ffa65a6a45ca3920 Mon Sep 17 00:00:00 2001 From: sh Date: Wed, 17 Jun 2026 07:59:17 +0000 Subject: [PATCH 4/4] ntf server: use ifM for push provider guard (review) --- src/Simplex/Messaging/Notifications/Server.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index f50775d2fe..07cc57e4e6 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -641,11 +641,10 @@ showServer' = decodeLatin1 . strEncode . host pushNotification :: NtfPushServer -> Maybe T.Text -> OwnServer -> NtfTknRec -> PushNotification -> M () pushNotification s srvHost_ isOwn tkn@NtfTknRec {token = token@(DeviceToken pp _)} ntf = - pushProviderAllowed token >>= \case - True -> do - q <- getOrCreatePushWorker s (srvHost_, pp) isOwn - atomically $ writeTBQueue q (tkn, ntf) - False -> liftIO $ logWarn "skipping disabled APNS test push provider" + ifM + (pushProviderAllowed token) + (getOrCreatePushWorker s (srvHost_, pp) isOwn >>= atomically . (`writeTBQueue` (tkn, ntf))) + (logWarn "skipping disabled APNS test push provider") pushProviderAllowed :: DeviceToken -> M Bool pushProviderAllowed (DeviceToken PPApnsTest _) = asks (allowTestPushProvider . config) @@ -653,9 +652,10 @@ pushProviderAllowed _ = pure True guardPushProvider :: DeviceToken -> M NtfResponse -> M NtfResponse guardPushProvider token action = - pushProviderAllowed token >>= \case - True -> action - False -> pure $ NRErr $ CMD SMP.PROHIBITED + ifM + (pushProviderAllowed token) + action + (pure $ NRErr $ CMD SMP.PROHIBITED) getOrCreatePushWorker :: NtfPushServer -> (Maybe T.Text, PushProvider) -> OwnServer -> M (TBQueue (NtfTknRec, PushNotification)) getOrCreatePushWorker s@NtfPushServer {pushWorkers, pushWorkerSeq, pushQSize} key@(srvHost_, _) isOwn = do