From 64e772bfb0cbe39e1b8da5263ec2268e93148e5d Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Thu, 8 Feb 2024 13:41:21 +0000 Subject: [PATCH] support authenticators in NTF protocol, test matrix (no backwards compatibility yet from new clients to old servers) --- src/Simplex/Messaging/Agent/Env/SQLite.hs | 2 + src/Simplex/Messaging/Notifications/Server.hs | 3 +- .../Messaging/Notifications/Transport.hs | 70 +++++--- src/Simplex/Messaging/Server.hs | 3 +- tests/AgentTests.hs | 2 +- tests/AgentTests/FunctionalAPITests.hs | 2 + tests/AgentTests/NotificationTests.hs | 154 ++++++++++-------- 7 files changed, 141 insertions(+), 95 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index 49947c040..558791e43 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -84,6 +84,7 @@ data InitialAgentServers = InitialAgentServers data AgentConfig = AgentConfig { tcpPort :: ServiceName, cmdAuthAlg :: C.AuthAlg, + cmdAuthAlgV6 :: C.AuthAlg, connIdBytes :: Int, tbqSize :: Natural, smpCfg :: ProtocolClientConfig, @@ -149,6 +150,7 @@ defaultAgentConfig = AgentConfig { tcpPort = "5224", cmdAuthAlg = C.AuthAlg C.SEd448, + cmdAuthAlgV6 = C.AuthAlg C.SEd448, connIdBytes = 12, tbqSize = 64, smpCfg = defaultSMPClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)}, diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index 2b3254b0a..8215c08a6 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -87,7 +87,8 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do runClient :: Transport c => TProxy c -> c -> M () runClient _ h = do kh <- asks serverIdentity - liftIO (runExceptT $ ntfServerHandshake h kh supportedNTFServerVRange) >>= \case + ks <- atomically . C.generateKeyPair =<< asks random + liftIO (runExceptT $ ntfServerHandshake h ks kh supportedNTFServerVRange) >>= \case Right th -> runNtfClientTransport th Left _ -> pure () diff --git a/src/Simplex/Messaging/Notifications/Transport.hs b/src/Simplex/Messaging/Notifications/Transport.hs index 6818565d4..c0c3e2b73 100644 --- a/src/Simplex/Messaging/Notifications/Transport.hs +++ b/src/Simplex/Messaging/Notifications/Transport.hs @@ -2,11 +2,14 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Simplex.Messaging.Notifications.Transport where import Control.Monad.Except +import Data.Attoparsec.ByteString.Char8 (Parser) +import Data.ByteString.Char8 (ByteString) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding import Simplex.Messaging.Transport @@ -15,59 +18,88 @@ import Simplex.Messaging.Version ntfBlockSize :: Int ntfBlockSize = 512 +authEncryptCmdsNTFVersion :: Version +authEncryptCmdsNTFVersion = 2 + +currentNTFServerVersion :: Version +currentNTFServerVersion = 1 + supportedNTFServerVRange :: VersionRange -supportedNTFServerVRange = mkVersionRange 1 1 +supportedNTFServerVRange = mkVersionRange 1 currentNTFServerVersion data NtfServerHandshake = NtfServerHandshake { ntfVersionRange :: VersionRange, - sessionId :: SessionId + sessionId :: SessionId, + -- pub key to agree shared secrets for command authorization and entity ID encryption. + authPubKey :: Maybe C.PublicKeyX25519 } data NtfClientHandshake = NtfClientHandshake { -- | agreed SMP notifications server protocol version ntfVersion :: Version, -- | server identity - CA certificate fingerprint - keyHash :: C.KeyHash + keyHash :: C.KeyHash, + -- pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys. + authPubKey :: Maybe C.PublicKeyX25519 } instance Encoding NtfServerHandshake where - smpEncode NtfServerHandshake {ntfVersionRange, sessionId} = - smpEncode (ntfVersionRange, sessionId) + smpEncode NtfServerHandshake {ntfVersionRange, sessionId, authPubKey} = + smpEncode (ntfVersionRange, sessionId) <> encodeNtfAuthPubKey (maxVersion ntfVersionRange) authPubKey smpP = do (ntfVersionRange, sessionId) <- smpP - pure NtfServerHandshake {ntfVersionRange, sessionId} + -- TODO drop SMP v6: remove special parser and make key non-optional + authPubKey <- ntfAuthPubKeyP $ maxVersion ntfVersionRange + pure NtfServerHandshake {ntfVersionRange, sessionId, authPubKey} instance Encoding NtfClientHandshake where - smpEncode NtfClientHandshake {ntfVersion, keyHash} = smpEncode (ntfVersion, keyHash) + smpEncode NtfClientHandshake {ntfVersion, keyHash, authPubKey} = + smpEncode (ntfVersion, keyHash) <> encodeNtfAuthPubKey ntfVersion authPubKey smpP = do (ntfVersion, keyHash) <- smpP - pure NtfClientHandshake {ntfVersion, keyHash} + -- TODO drop SMP v6: remove special parser and make key non-optional + authPubKey <- ntfAuthPubKeyP ntfVersion + pure NtfClientHandshake {ntfVersion, keyHash, authPubKey} + +ntfAuthPubKeyP :: Version -> Parser (Maybe C.PublicKeyX25519) +ntfAuthPubKeyP v = if v >= authEncryptCmdsNTFVersion then Just <$> smpP else pure Nothing + +encodeNtfAuthPubKey :: Version -> Maybe C.PublicKeyX25519 -> ByteString +encodeNtfAuthPubKey v k + | v >= authEncryptCmdsNTFVersion = maybe "" smpEncode k + | otherwise = "" -- | Notifcations server transport handshake. -ntfServerHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c) -ntfServerHandshake c kh ntfVRange = do +ntfServerHandshake :: forall c. Transport c => c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c) +ntfServerHandshake c (k, pk) kh ntfVRange = do let th@THandle {sessionId} = ntfTHandle c - sendHandshake th $ NtfServerHandshake {sessionId, ntfVersionRange = ntfVRange} + sendHandshake th $ NtfServerHandshake {sessionId, ntfVersionRange = ntfVRange, authPubKey = Just k} getHandshake th >>= \case - NtfClientHandshake {ntfVersion, keyHash} + NtfClientHandshake {ntfVersion = v, keyHash, authPubKey = k'} | keyHash /= kh -> throwError $ TEHandshake IDENTITY - | ntfVersion `isCompatible` ntfVRange -> - pure (th :: THandle c) {thVersion = ntfVersion} + | v `isCompatible` ntfVRange -> + pure $ ntfThHandle th v pk k' | otherwise -> throwError $ TEHandshake VERSION -- | Notifcations server client transport handshake. ntfClientHandshake :: forall c. Transport c => c -> C.KeyPairX25519 -> C.KeyHash -> VersionRange -> ExceptT TransportError IO (THandle c) -ntfClientHandshake c _ keyHash ntfVRange = do +ntfClientHandshake c (k, pk) keyHash ntfVRange = do let th@THandle {sessionId} = ntfTHandle c - NtfServerHandshake {sessionId = sessId, ntfVersionRange} <- getHandshake th + NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey = k'} <- getHandshake th if sessionId /= sessId then throwError TEBadSession else case ntfVersionRange `compatibleVersion` ntfVRange of - Just (Compatible ntfVersion) -> do - sendHandshake th $ NtfClientHandshake {ntfVersion, keyHash} - pure (th :: THandle c) {thVersion = ntfVersion} + Just (Compatible v) -> do + sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash, authPubKey = Just k} + pure $ ntfThHandle th v pk k' Nothing -> throwError $ TEHandshake VERSION +ntfThHandle :: forall c. THandle c -> Version -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandle c +ntfThHandle th v pk k_ = + -- TODO drop SMP v6: make thAuth non-optional + let thAuth = (\k -> THandleAuth {peerPubKey = k, privKey = pk, dhSecret = C.dh' k pk}) <$> k_ + in (th :: THandle c) {thVersion = v, thAuth} + ntfTHandle :: Transport c => c -> THandle c ntfTHandle c = THandle {connection = c, sessionId = tlsUnique c, blockSize = ntfBlockSize, thVersion = 0, thAuth = Nothing, batch = False} diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 6ad78435b..279af86fc 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -247,9 +247,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do runClient :: Transport c => TProxy c -> c -> M () runClient tp h = do kh <- asks serverIdentity + ks <- atomically . C.generateKeyPair =<< asks random ServerConfig {smpServerVRange, smpHandshakeTimeout} <- asks config - g <- asks random - ks <- atomically $ C.generateKeyPair g labelMyThread $ "smp handshake for " <> transportName tp liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake h ks kh smpServerVRange) >>= \case Just (Right th) -> runClientTransport th diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 589683a78..664ab4866 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -41,7 +41,7 @@ agentTests (ATransport t) = do describe "Connection request" connectionRequestTests describe "Double ratchet tests" doubleRatchetTests describe "Functional API" $ functionalAPITests (ATransport t) - describe "Notification tests" $ notificationTests (ATransport t) + fdescribe "Notification tests" $ notificationTests (ATransport t) describe "SQLite store" storeTests describe "Migration tests" migrationTests describe "SMP agent protocol syntax" $ syntaxTests t diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 2112f9e59..768af0ae8 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -15,6 +15,7 @@ module AgentTests.FunctionalAPITests ( functionalAPITests, testServerMatrix2, + withAgentClientsCfg2, getSMPAgentClient', makeConnection, exchangeGreetingsMsgId, @@ -29,6 +30,7 @@ module AgentTests.FunctionalAPITests (##>), (=##>), pattern Msg, + agentCfgV7, ) where diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 15ba1993e..16182470d 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -6,11 +7,12 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module AgentTests.NotificationTests where -- import Control.Logger.Simple (LogConfig (..), LogLevel (..), setLogLevel, withGlobalLogging) -import AgentTests.FunctionalAPITests (exchangeGreetingsMsgId, get, getSMPAgentClient', makeConnection, nGet, runRight, runRight_, switchComplete, testServerMatrix2, (##>), (=##>), pattern Msg) +import AgentTests.FunctionalAPITests (agentCfgV7, exchangeGreetingsMsgId, get, getSMPAgentClient', makeConnection, nGet, runRight, runRight_, switchComplete, testServerMatrix2, withAgentClientsCfg2, (##>), (=##>), pattern Msg) import Control.Concurrent (ThreadId, killThread, threadDelay) import Control.Monad import Control.Monad.Except @@ -24,14 +26,15 @@ import Data.ByteString.Char8 (ByteString) 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 SMPClient (cfg, 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.Env.SQLite (AgentConfig, InitialAgentServers) import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store.SQLite (getSavedNtfToken) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..)) import Simplex.Messaging.Notifications.Protocol import Simplex.Messaging.Notifications.Server.Push.APNS import Simplex.Messaging.Notifications.Types (NtfToken (..)) @@ -49,72 +52,83 @@ 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 "Managing notification subscriptions" $ do + fdescribe "should create notification subscription for existing connection" $ + testNtfMatrix t testNotificationSubscriptionExistingConnection + it "should create notification subscription for new connection" $ withSmpServer t $ withAPNSMockServer $ \apns -> - withNtfServerOn t ntfTestPort $ - testNotificationsOldToken apns - it "should update server from new token" $ + withNtfServer t $ testNotificationSubscriptionNewConnection apns + it "should change notifications mode" $ withSmpServer t $ withAPNSMockServer $ \apns -> - withNtfServerOn t ntfTestPort2 . withNtfServerThreadOn t ntfTestPort $ \ntf -> - testNotificationsNewToken apns ntf + 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" $ + withSmpServer t $ + withAPNSMockServer $ \apns -> + withNtfServerOn t ntfTestPort $ + testNotificationsOldToken apns + it "should update server from new token" $ + withSmpServer t $ + withAPNSMockServer $ \apns -> + withNtfServerOn t ntfTestPort2 . withNtfServerThreadOn t ntfTestPort $ \ntf -> + testNotificationsNewToken apns ntf + +testNtfMatrix :: ATransport -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> Spec +testNtfMatrix t runTest = do + -- it "v7 clients, v7 smp, v2 ntf server" $ runNtfTest cfg ntfServerCfg agentCfgV7 agentCfgV7 runTest + it "v6 clients, v6 smp, v1 ntf server" $ runNtfTestCfg t cfg ntfServerCfg agentCfg agentCfg runTest + -- it "v7 clients, v6 smp, v1 ntf server" $ runNtfTestCfg t cfg ntfServerCfg agentCfgV7 agentCfgV7 runTest + -- it "v7 to current" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfg 3 runTest + -- it "current to v7" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfgV7 3 runTest + +runNtfTestCfg :: ATransport -> ServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> IO () +runNtfTestCfg t smpCfg ntfCfg aCfg bCfg runTest = + withSmpServerConfigOn t smpCfg testPort $ \_ -> + withAPNSMockServer $ \apns -> + withNtfServerCfg ntfCfg {transports = [(ntfTestPort, t)]} $ \_ -> + withAgentClientsCfg2 aCfg bCfg $ runTest apns testNotificationToken :: APNSMockServer -> IO () testNotificationToken APNSMockServer {apnsQ} = do @@ -294,10 +308,8 @@ 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 +testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentClient -> AgentClient -> IO () +testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice bob = do (bobId, aliceId, nonce, message) <- runRight $ do -- establish connection (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe @@ -346,8 +358,6 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} = do get bob ##> ("", aliceId, SENT $ baseId + 2) -- no notifications should follow noNotification apnsQ - disconnectAgentClient alice - disconnectAgentClient bob where baseId = 3 msgId = subtract baseId @@ -625,7 +635,7 @@ testNotificationsSMPRestartBatch n t APNSMockServer {apnsQ} = do runServers :: ExceptT AgentErrorType IO a -> IO a runServers a = do withSmpServerStoreLogOn t testPort $ \t1 -> do - res <- withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \t2 -> + res <- withSmpServerConfigOn t (cfg :: ServerConfig) {storeLogFile = Just testStoreLogFile2} testPort2 $ \t2 -> runRight a `finally` killThread t2 killThread t1 pure res