From b4c23520c73786b7c3ff539ff80b37f07ffe68d4 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 17 Feb 2024 14:55:40 +0000 Subject: [PATCH] agent: test NTF server (#1000) --- src/Simplex/Messaging/Agent.hs | 3 +- src/Simplex/Messaging/Agent/Client.hs | 28 +++++ .../Messaging/Notifications/Protocol.hs | 10 +- .../Messaging/Notifications/Server/Env.hs | 4 +- .../Notifications/Server/Push/APNS.hs | 9 +- src/Simplex/Messaging/Protocol.hs | 3 + tests/AgentTests/NotificationTests.hs | 113 ++++++++---------- 7 files changed, 97 insertions(+), 73 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 3a39686bf..e0b70cf20 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -338,10 +338,11 @@ setProtocolServers :: forall p m. (ProtocolTypeI p, UserProtocol p, AgentErrorMo setProtocolServers c = withAgentEnv c .: setProtocolServers' c -- | Test protocol server -testProtocolServer :: forall p m. (ProtocolTypeI p, UserProtocol p, AgentErrorMonad m) => AgentClient -> UserId -> ProtoServerWithAuth p -> m (Maybe ProtocolTestFailure) +testProtocolServer :: forall p m. (ProtocolTypeI p, AgentErrorMonad m) => AgentClient -> UserId -> ProtoServerWithAuth p -> m (Maybe ProtocolTestFailure) testProtocolServer c userId srv = withAgentEnv c $ case protocolTypeI @p of SPSMP -> runSMPServerTest c userId srv SPXFTP -> runXFTPServerTest c userId srv + SPNTF -> runNTFServerTest c userId srv setNtfServers :: MonadUnliftIO m => AgentClient -> [NtfServer] -> m () setNtfServers c = withAgentEnv c . setNtfServers' c diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index d24af2be8..b0c355682 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -32,6 +32,7 @@ module Simplex.Messaging.Agent.Client closeXFTPServerClient, runSMPServerTest, runXFTPServerTest, + runNTFServerTest, getXFTPWorkPath, newRcvQueue, subscribeQueues, @@ -193,6 +194,7 @@ import Simplex.Messaging.Protocol MsgFlags (..), MsgId, NtfServer, + NtfServerWithAuth, ProtoServer, ProtoServerWithAuth (..), Protocol (..), @@ -868,6 +870,8 @@ data ProtocolTestStep | TSDownloadFile | TSCompareFile | TSDeleteFile + | TSCreateNtfToken + | TSDeleteNtfToken deriving (Eq, Show) data ProtocolTestFailure = ProtocolTestFailure @@ -945,6 +949,30 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do createTestChunk :: FilePath -> IO () createTestChunk fp = B.writeFile fp =<< atomically . C.randomBytes chSize =<< C.newRandom +runNTFServerTest :: AgentMonad m => AgentClient -> UserId -> NtfServerWithAuth -> m (Maybe ProtocolTestFailure) +runNTFServerTest c userId (ProtoServerWithAuth srv _) = do + cfg <- getClientConfig c ntfCfg + C.AuthAlg a <- asks $ rcvAuthAlg . config + g <- asks random + liftIO $ do + let tSess = (userId, srv, Nothing) + getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case + Right ntf -> do + (nKey, npKey) <- atomically $ C.generateAuthKeyPair a g + (dhKey, _) <- atomically $ C.generateKeyPair g + r <- runExceptT $ do + let deviceToken = DeviceToken PPApnsNull "test_ntf_token" + (tknId, _) <- liftError (testErr TSCreateNtfToken) $ ntfRegisterToken ntf npKey (NewNtfTkn deviceToken nKey dhKey) + liftError (testErr TSDeleteNtfToken) $ ntfDeleteToken ntf npKey tknId + ok <- tcpTimeout (networkConfig cfg) `timeout` closeProtocolClient ntf + incClientStat c userId ntf "NTF_TEST" "OK" + pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok + Left e -> pure (Just $ testErr TSConnect e) + where + addr = B.unpack $ strEncode srv + testErr :: ProtocolTestStep -> SMPClientError -> ProtocolTestFailure + testErr step = ProtocolTestFailure step . protocolClientError SMP addr + getXFTPWorkPath :: AgentMonad m => m FilePath getXFTPWorkPath = do workDir <- readTVarIO =<< asks (xftpWorkDir . xftpAgent) diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 77b9c10bf..abcbfd3b1 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -358,7 +358,11 @@ instance StrEncoding SMPQueueNtf where notifierId <- A.char '/' *> strP pure SMPQueueNtf {smpServer, notifierId} -data PushProvider = PPApnsDev | PPApnsProd | PPApnsTest +data PushProvider + = PPApnsDev -- provider for Apple development environment + | PPApnsProd -- production environment, including TestFlight + | PPApnsTest -- used for tests, to use APNS mock server + | PPApnsNull -- used to test servers from the client - does not communicate with APNS deriving (Eq, Ord, Show) instance Encoding PushProvider where @@ -366,11 +370,13 @@ instance Encoding PushProvider where PPApnsDev -> "AD" PPApnsProd -> "AP" PPApnsTest -> "AT" + PPApnsNull -> "AN" smpP = A.take 2 >>= \case "AD" -> pure PPApnsDev "AP" -> pure PPApnsProd "AT" -> pure PPApnsTest + "AN" -> pure PPApnsNull _ -> fail "bad PushProvider" instance StrEncoding PushProvider where @@ -378,11 +384,13 @@ instance StrEncoding PushProvider where PPApnsDev -> "apns_dev" PPApnsProd -> "apns_prod" PPApnsTest -> "apns_test" + PPApnsNull -> "apns_null" strP = A.takeTill (== ' ') >>= \case "apns_dev" -> pure PPApnsDev "apns_prod" -> pure PPApnsProd "apns_test" -> pure PPApnsTest + "apns_null" -> pure PPApnsNull _ -> fail "bad PushProvider" instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8 diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index e1b4f51c5..d0650b002 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -142,7 +142,9 @@ newNtfPushServer qSize apnsConfig = do newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient newPushClient NtfPushServer {apnsConfig, pushClients} pp = do - c <- apnsPushProviderClient <$> createAPNSPushClient (apnsProviderHost pp) apnsConfig + c <- case apnsProviderHost pp of + Nothing -> pure $ \_ _ -> pure () + Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig atomically $ TM.insert pp c pushClients pure c diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs index 5d8e298ea..9c3de04df 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs @@ -193,11 +193,12 @@ data APNSPushClientConfig = APNSPushClientConfig caStoreFile :: FilePath } -apnsProviderHost :: PushProvider -> HostName +apnsProviderHost :: PushProvider -> Maybe HostName apnsProviderHost = \case - PPApnsTest -> "localhost" - PPApnsDev -> "api.sandbox.push.apple.com" - PPApnsProd -> "api.push.apple.com" + PPApnsNull -> Nothing + PPApnsTest -> Just "localhost" + PPApnsDev -> Just "api.sandbox.push.apple.com" + PPApnsProd -> Just "api.push.apple.com" defaultAPNSPushClientConfig :: APNSPushClientConfig defaultAPNSPushClientConfig = diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index f2571a9d4..4e1e476b8 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -79,6 +79,7 @@ module Simplex.Messaging.Protocol SMPServerWithAuth, NtfServer, pattern NtfServer, + NtfServerWithAuth, XFTPServer, pattern XFTPServer, XFTPServerWithAuth, @@ -674,6 +675,8 @@ pattern NtfServer host port keyHash = ProtocolServer SPNTF host port keyHash {-# COMPLETE NtfServer #-} +type NtfServerWithAuth = ProtoServerWithAuth 'PNTF + type XFTPServer = ProtocolServer 'PXFTP pattern XFTPServer :: NonEmpty TransportHost -> ServiceName -> C.KeyHash -> ProtocolServer 'PXFTP diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 15ba1993e..f50b3d8c2 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -21,13 +21,14 @@ import qualified Data.Aeson.Types as JT import Data.Bifunctor (bimap, first) import qualified Data.ByteString.Base64.URL as U import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B import Data.Text.Encoding (encodeUtf8) import NtfClient -import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testDB3, testNtfServer2) -import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, xit') +import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testDB3, testNtfServer, testNtfServer2) +import SMPClient (cfg, cfgV7, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn) import Simplex.Messaging.Agent -import Simplex.Messaging.Agent.Client (withStore') -import Simplex.Messaging.Agent.Env.SQLite (InitialAgentServers) +import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore') +import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, Env (..), InitialAgentServers) import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store.SQLite (getSavedNtfToken) import qualified Simplex.Messaging.Crypto as C @@ -35,7 +36,7 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Protocol import Simplex.Messaging.Notifications.Server.Push.APNS import Simplex.Messaging.Notifications.Types (NtfToken (..)) -import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), ProtocolServer (..), SMPMsgMeta (..), SubscriptionMode (..)) +import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), NtfServer, ProtocolServer (..), SMPMsgMeta (..), SubscriptionMode (..)) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Server.Env.STM (ServerConfig (..)) import Simplex.Messaging.Transport (ATransport) @@ -49,63 +50,37 @@ removeFileIfExists filePath = do when fileExists $ removeFile filePath notificationTests :: ATransport -> Spec -notificationTests t = - after_ (removeFileIfExists testDB >> removeFileIfExists testDB2) $ do - describe "Managing notification tokens" $ do - it "should register and verify notification token" $ - withAPNSMockServer $ \apns -> - withNtfServer t $ testNotificationToken apns - it "should allow repeated registration with the same credentials" $ \_ -> - withAPNSMockServer $ \apns -> - withNtfServer t $ testNtfTokenRepeatRegistration apns - it "should allow the second registration with different credentials and delete the first after verification" $ \_ -> - withAPNSMockServer $ \apns -> - withNtfServer t $ testNtfTokenSecondRegistration apns - it "should re-register token when notification server is restarted" $ \_ -> - withAPNSMockServer $ \apns -> - testNtfTokenServerRestart t apns - it "should work with multiple configured servers" $ \_ -> - withAPNSMockServer $ \apns -> - testNtfTokenMultipleServers t apns - it "should keep working with active token until replaced" $ \_ -> - withAPNSMockServer $ \apns -> - testNtfTokenChangeServers t apns - describe "Managing notification subscriptions" $ do - -- fails on Ubuntu CI? - xit' "should create notification subscription for existing connection" $ \_ -> do - withSmpServer t $ - withAPNSMockServer $ \apns -> - withNtfServer t $ testNotificationSubscriptionExistingConnection apns - it "should create notification subscription for new connection" $ \_ -> - withSmpServer t $ - withAPNSMockServer $ \apns -> - withNtfServer t $ testNotificationSubscriptionNewConnection apns - it "should change notifications mode" $ \_ -> - withSmpServer t $ - withAPNSMockServer $ \apns -> - withNtfServer t $ testChangeNotificationsMode apns - it "should change token" $ \_ -> - withSmpServer t $ - withAPNSMockServer $ \apns -> - withNtfServer t $ testChangeToken apns - describe "Notifications server store log" $ - it "should save and restore tokens and subscriptions" $ \_ -> - withSmpServer t $ - withAPNSMockServer $ \apns -> - testNotificationsStoreLog t apns - describe "Notifications after SMP server restart" $ - it "should resume subscriptions after SMP server is restarted" $ \_ -> - withAPNSMockServer $ \apns -> - withNtfServer t $ testNotificationsSMPRestart t apns - describe "Notifications after SMP server restart" $ - it "should resume batched subscriptions after SMP server is restarted" $ \_ -> - withAPNSMockServer $ \apns -> - withNtfServer t $ testNotificationsSMPRestartBatch 100 t apns - describe "should switch notifications to the new queue" $ - testServerMatrix2 t $ \servers -> - withAPNSMockServer $ \apns -> - withNtfServer t $ testSwitchNotifications servers apns - it "should keep sending notifications for old token" $ +notificationTests t = do + describe "Managing notification tokens" $ do + it "should register and verify notification token" $ + withAPNSMockServer $ \apns -> + withNtfServer t $ testNotificationToken apns + it "should allow repeated registration with the same credentials" $ + withAPNSMockServer $ \apns -> + withNtfServer t $ testNtfTokenRepeatRegistration apns + it "should allow the second registration with different credentials and delete the first after verification" $ + withAPNSMockServer $ \apns -> + withNtfServer t $ testNtfTokenSecondRegistration apns + it "should re-register token when notification server is restarted" $ + withAPNSMockServer $ \apns -> + testNtfTokenServerRestart t apns + it "should work with multiple configured servers" $ + withAPNSMockServer $ \apns -> + testNtfTokenMultipleServers t apns + it "should keep working with active token until replaced" $ + withAPNSMockServer $ \apns -> + testNtfTokenChangeServers t apns + describe "notification server tests" $ do + it "should pass" $ testRunNTFServerTests t testNtfServer `shouldReturn` Nothing + let srv1 = testNtfServer {keyHash = "1234"} + it "should fail with incorrect fingerprint" $ do + testRunNTFServerTests t srv1 `shouldReturn` Just (ProtocolTestFailure TSConnect $ BROKER (B.unpack $ strEncode srv1) NETWORK) + describe "Managing notification subscriptions" $ do + describe "should create notification subscription for existing connection" $ + testNtfMatrix t testNotificationSubscriptionExistingConnection + describe "should create notification subscription for new connection" $ + testNtfMatrix t testNotificationSubscriptionNewConnection + it "should change notifications mode" $ withSmpServer t $ withAPNSMockServer $ \apns -> withNtfServerOn t ntfTestPort $ @@ -294,10 +269,16 @@ testNtfTokenChangeServers t APNSMockServer {apnsQ} = tkn <- registerTestToken a "qwer" NMInstant apnsQ checkNtfToken a tkn >>= \r -> liftIO $ r `shouldBe` NTActive -testNotificationSubscriptionExistingConnection :: APNSMockServer -> IO () -testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} = do - alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB - bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2 +testRunNTFServerTests :: ATransport -> NtfServer -> IO (Maybe ProtocolTestFailure) +testRunNTFServerTests t srv = + withNtfServerThreadOn t ntfTestPort $ \ntf -> do + a <- liftIO $ getSMPAgentClient' 1 agentCfg initAgentServers testDB + r <- runRight $ testProtocolServer a 1 $ ProtoServerWithAuth srv Nothing + killThread ntf + pure r + +testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentClient -> AgentClient -> IO () +testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@AgentClient {agentEnv = Env {config = aliceCfg}} bob = do (bobId, aliceId, nonce, message) <- runRight $ do -- establish connection (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe