diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index 02429e910..07cc57e4e 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -640,9 +640,22 @@ 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 = + 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) +pushProviderAllowed _ = pure True + +guardPushProvider :: DeviceToken -> M NtfResponse -> M NtfResponse +guardPushProvider token action = + 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 @@ -834,7 +847,7 @@ 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 + 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 @@ -846,10 +859,10 @@ client NtfServerClient {rcvQ, sndQ} ns@NtfSubscriber {smpAgent = ca} ps = pushNotification ps Nothing False tkn $ PNVerification regCode incNtfStatT token ntfVrfQueued incNtfStatT token tknCreated - pure $ NRTknId tknId srvDhPubKey + 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 + 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 @@ -872,7 +885,7 @@ client NtfServerClient {rcvQ, sndQ} ns@NtfSubscriber {smpAgent = ca} ps = TCHK -> do logDebug "TCHK" pure $ NRTkn tknStatus - TRPL token' -> do + TRPL token' -> guardPushProvider token' $ do logDebug "TRPL - replace token" regCode <- getRegCode let tkn' = tkn {token = token', tknStatus = NTRegistered, tknRegCode = regCode} diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index 365d464c8..6f9416db4 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 cba3bddd9..d1fd2496d 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 d7b72b766..9835e1cdd 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 5a44574d1..7fd430fef 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) @@ -52,6 +53,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 +75,19 @@ ntfSyntaxTests (ATransport t) = do Expectation command >#> response = withAPNSMockServer $ \_ -> ntfServerTest t command `shouldReturn` response +testApnsTestProviderRejected :: ASrvTransport -> Expectation +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" + 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 () + pattern RespNtf :: CorrId -> QueueId -> NtfResponse -> Transmission (Either ErrorType NtfResponse) pattern RespNtf corrId queueId command <- (corrId, queueId, Right command)