diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index a028da52f..71e710473 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -149,10 +149,10 @@ defaultAgentConfig :: AgentConfig defaultAgentConfig = AgentConfig { tcpPort = "5224", - -- while the current client version supports X25519, it can only be enabled once support for SMP v7 is dropped, - -- and all servers are required to support v8 to be compatible. + -- while the current client version supports X25519, it can only be enabled once support for SMP v6 is dropped, + -- and all servers are required to support v7 to be compatible. rcvAuthAlg = C.AuthAlg C.SEd25519, -- this will stay as Ed25519 - sndAuthAlg = C.AuthAlg C.SEd25519, -- TODO replace with X25519 when switching to v8 + sndAuthAlg = C.AuthAlg C.SEd25519, -- TODO replace with X25519 when switching to v7 connIdBytes = 12, tbqSize = 64, smpCfg = defaultSMPClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)}, diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index dbd8c2d6a..9bae3042d 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -155,7 +155,7 @@ clientStub g sessionId thVersion thAuth = do thVersion, thAuth, blockSize = smpBlockSize, - encrypt = thVersion >= dontSendSessionIdSMPVersion, + encrypt = thVersion >= authEncryptCmdsSMPVersion, batch = True }, sessionTs = undefined, diff --git a/src/Simplex/Messaging/Notifications/Transport.hs b/src/Simplex/Messaging/Notifications/Transport.hs index 5475c0e24..ab48a0e22 100644 --- a/src/Simplex/Messaging/Notifications/Transport.hs +++ b/src/Simplex/Messaging/Notifications/Transport.hs @@ -22,17 +22,14 @@ import Simplex.Messaging.Util (liftEitherWith) ntfBlockSize :: Int ntfBlockSize = 512 -dontSendSessionIdNTFVersion :: Version -dontSendSessionIdNTFVersion = 2 - authEncryptCmdsNTFVersion :: Version -authEncryptCmdsNTFVersion = 3 +authEncryptCmdsNTFVersion = 2 currentClientNTFVersion :: Version -currentClientNTFVersion = 2 +currentClientNTFVersion = 1 currentServerNTFVersion :: Version -currentServerNTFVersion = 2 +currentServerNTFVersion = 1 supportedClientNTFVRange :: VersionRange supportedClientNTFVRange = mkVersionRange 1 currentClientNTFVersion @@ -129,7 +126,7 @@ ntfThHandle :: forall c. THandle c -> Version -> C.PrivateKeyX25519 -> Maybe C.P ntfThHandle th@THandle {params} v privKey k_ = -- TODO drop SMP v6: make thAuth non-optional let thAuth = (\k -> THandleAuth {peerPubKey = k, privKey}) <$> k_ - params' = params {thVersion = v, thAuth, encrypt = v >= dontSendSessionIdNTFVersion} + params' = params {thVersion = v, thAuth, encrypt = v >= authEncryptCmdsNTFVersion} in (th :: THandle c) {params = params'} ntfTHandle :: Transport c => c -> THandle c diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index e641a49d3..966252aa0 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -33,7 +33,6 @@ module Simplex.Messaging.Transport currentServerSMPRelayVersion, basicAuthSMPVersion, subModeSMPVersion, - dontSendSessionIdSMPVersion, authEncryptCmdsSMPVersion, simplexMQVersion, smpBlockSize, @@ -126,17 +125,14 @@ basicAuthSMPVersion = 5 subModeSMPVersion :: Version subModeSMPVersion = 6 -dontSendSessionIdSMPVersion :: Version -dontSendSessionIdSMPVersion = 7 - authEncryptCmdsSMPVersion :: Version -authEncryptCmdsSMPVersion = 8 +authEncryptCmdsSMPVersion = 7 currentClientSMPRelayVersion :: Version -currentClientSMPRelayVersion = 7 +currentClientSMPRelayVersion = 6 currentServerSMPRelayVersion :: Version -currentServerSMPRelayVersion = 7 +currentServerSMPRelayVersion = 6 -- minimal supported protocol version is 4 -- TODO remove code that supports sending commands without batching @@ -474,7 +470,7 @@ smpThHandle :: forall c. THandle c -> Version -> C.PrivateKeyX25519 -> Maybe C.P smpThHandle th@THandle {params} v privKey k_ = -- TODO drop SMP v6: make thAuth non-optional let thAuth = (\k -> THandleAuth {peerPubKey = k, privKey}) <$> k_ - params' = params {thVersion = v, thAuth, encrypt = v >= dontSendSessionIdSMPVersion, batch = v >= batchCmdsSMPVersion} + params' = params {thVersion = v, thAuth, encrypt = v >= authEncryptCmdsSMPVersion, batch = v >= batchCmdsSMPVersion} in (th :: THandle c) {params = params'} sendHandshake :: (Transport c, Encoding smp) => THandle c -> smp -> ExceptT TransportError IO () diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 4deab8276..5483e2747 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -30,7 +30,7 @@ module AgentTests.FunctionalAPITests (##>), (=##>), pattern Msg, - agentCfgV8, + agentCfgV7, ) where @@ -51,7 +51,7 @@ import Data.Time.Clock.System (SystemTime (..), getSystemTime) import Data.Type.Equality import qualified Database.SQLite.Simple as SQL import SMPAgentClient -import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerV8, withSmpServerConfigOn, withSmpServerOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn) +import SMPClient (cfg, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerV7, withSmpServerConfigOn, withSmpServerOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn) import Simplex.Messaging.Agent import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..)) import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore) @@ -147,8 +147,8 @@ agentCfgVPrev = smpCfg = smpCfgVPrev } -agentCfgV8 :: AgentConfig -agentCfgV8 = +agentCfgV7 :: AgentConfig +agentCfgV7 = agentCfg { sndAuthAlg = C.AuthAlg C.SX25519, smpCfg = smpCfgV7, @@ -380,10 +380,10 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) = testMatrix2 :: ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testMatrix2 t runTest = do - it "v8" $ withSmpServerV8 t $ runTestCfg2 agentCfgV8 agentCfgV8 3 runTest - it "v8 to current" $ withSmpServerV8 t $ runTestCfg2 agentCfgV8 agentCfg 3 runTest - it "current to v8" $ withSmpServerV8 t $ runTestCfg2 agentCfg agentCfgV8 3 runTest - it "current with v8 server" $ withSmpServerV8 t $ runTestCfg2 agentCfg agentCfg 3 runTest + it "v7" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 runTest + it "v7 to current" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfg 3 runTest + it "current to v7" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfgV7 3 runTest + it "current with v7 server" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfg 3 runTest it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 runTest it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 runTest it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 runTest diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 097e75052..e5d6ad7db 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -12,7 +12,7 @@ module AgentTests.NotificationTests where -- import Control.Logger.Simple (LogConfig (..), LogLevel (..), setLogLevel, withGlobalLogging) -import AgentTests.FunctionalAPITests (agentCfgV8, exchangeGreetingsMsgId, get, getSMPAgentClient', makeConnection, nGet, runRight, runRight_, switchComplete, testServerMatrix2, withAgentClientsCfg2, (##>), (=##>), 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 @@ -26,7 +26,7 @@ import Data.ByteString.Char8 (ByteString) import Data.Text.Encoding (encodeUtf8) import NtfClient import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testDB3, testNtfServer2) -import SMPClient (cfg, cfgV8, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn) +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 (AgentConfig, Env (..), InitialAgentServers) @@ -116,30 +116,17 @@ notificationTests t = do testNtfMatrix :: ATransport -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> Spec testNtfMatrix t runTest = do describe "next and current" $ do - it "next servers: SMP v8, NTF v3; next clients: v8/v3" $ runNtfTestCfg t cfgV8 ntfServerCfgV3 agentCfgV8 agentCfgV8 runTest - it "next servers: SMP v8, NTF v3; curr clients: v7/v2" $ runNtfTestCfg t cfgV8 ntfServerCfgV3 agentCfg agentCfg runTest - it "curr servers: SMP v7, NTF v2; curr clients: v7/v2" $ runNtfTestCfg t cfg ntfServerCfg agentCfg agentCfg runTest + it "next servers: SMP v7, NTF v2; next clients: v7/v2" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfgV7 agentCfgV7 runTest + it "next servers: SMP v7, NTF v2; curr clients: v6/v1" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfg agentCfg runTest + it "curr servers: SMP v6, NTF v1; curr clients: v6/v1" $ runNtfTestCfg t cfg ntfServerCfg agentCfg agentCfg runTest -- this case will cannot be supported - see RFC - xit "servers: SMP v7, NTF v2; clients: v8/v3 (not supported)" $ runNtfTestCfg t cfg ntfServerCfg agentCfgV8 agentCfgV8 runTest + xit "servers: SMP v6, NTF v1; clients: v7/v2 (not supported)" $ runNtfTestCfg t cfg ntfServerCfg agentCfgV7 agentCfgV7 runTest -- servers can be migrated in any order - it "servers: next SMP v8, curr NTF v2; curr clients: v7/v2" $ runNtfTestCfg t cfgV8 ntfServerCfg agentCfg agentCfg runTest - it "servers: curr SMP v7, next NTF v3; curr clients: v7/v2" $ runNtfTestCfg t cfg ntfServerCfgV3 agentCfg agentCfg runTest + it "servers: next SMP v7, curr NTF v1; curr clients: v6/v1" $ runNtfTestCfg t cfgV7 ntfServerCfg agentCfg agentCfg runTest + it "servers: curr SMP v6, next NTF v2; curr clients: v6/v1" $ runNtfTestCfg t cfg ntfServerCfgV2 agentCfg agentCfg runTest -- clients can be partially migrated - it "servers: next SMP v8, curr NTF v3; clients: next/curr" $ runNtfTestCfg t cfgV8 ntfServerCfgV3 agentCfgV8 agentCfg runTest - it "servers: next SMP v8, curr NTF v3; clients: curr/new" $ runNtfTestCfg t cfgV8 ntfServerCfgV3 agentCfg agentCfgV8 runTest - describe "current and previous" $ do - it "curr servers: SMP v7, NTF v2; curr clients: v7/v2" $ runNtfTestCfg t cfgV8 ntfServerCfgV3 agentCfgV8 agentCfgV8 runTest - it "curr servers: SMP v7, NTF v2; prev clients: v6/v1" $ runNtfTestCfg t cfgV8 ntfServerCfgV3 agentCfg agentCfg runTest - it "prev servers: SMP v6, NTF v1; prev clients: v6/v1" $ runNtfTestCfg t cfg ntfServerCfg agentCfg agentCfg runTest - -- this case will cannot be supported - see RFC - xit "servers: SMP v6, NTF v1; clients: v7/v2 (not supported)" $ runNtfTestCfg t cfg ntfServerCfg agentCfgV8 agentCfgV8 runTest - -- servers can be migrated in any order - it "servers: curr SMP v7, prev NTF v1; prev clients: v6/v1" $ runNtfTestCfg t cfgV8 ntfServerCfg agentCfg agentCfg runTest - it "servers: prev SMP v6, curr NTF v2; prev clients: v6/v1" $ runNtfTestCfg t cfg ntfServerCfgV3 agentCfg agentCfg runTest - -- clients can be partially migrated - it "servers: curr SMP v7, prev NTF v2; clients: curr/prev" $ runNtfTestCfg t cfgV8 ntfServerCfgV3 agentCfgV8 agentCfg runTest - it "servers: curr SMP v7, prev NTF v2; clients: prev/new" $ runNtfTestCfg t cfgV8 ntfServerCfgV3 agentCfg agentCfgV8 runTest - + it "servers: next SMP v7, curr NTF v2; clients: next/curr" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfgV7 agentCfg runTest + it "servers: next SMP v7, curr NTF v2; clients: curr/new" $ runNtfTestCfg t cfgV7 ntfServerCfgV2 agentCfg agentCfgV7 runTest runNtfTestCfg :: ATransport -> ServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentClient -> AgentClient -> IO ()) -> IO () runNtfTestCfg t smpCfg ntfCfg aCfg bCfg runTest = diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs index 6b0984769..320c54052 100644 --- a/tests/CoreTests/BatchingTests.hs +++ b/tests/CoreTests/BatchingTests.hs @@ -21,41 +21,41 @@ import Test.Hspec batchingTests :: Spec batchingTests = do describe "batchTransmissions" $ do - describe "SMP v7 (current)" $ do - it "should batch with 109 subscriptions per batch" testBatchSubscriptions + describe "SMP v6 (current)" $ do + it "should batch with 107 subscriptions per batch" testBatchSubscriptions it "should break on message that does not fit" testBatchWithMessage it "should break on large message" testBatchWithLargeMessage - describe "v8 (next)" $ do - it "should batch with 142 subscriptions per batch" testBatchSubscriptionsV8 - it "should break on message that does not fit" testBatchWithMessageV8 - it "should break on large message" testBatchWithLargeMessageV8 + describe "v7 (next)" $ do + it "should batch with 136 subscriptions per batch" testBatchSubscriptionsV7 + it "should break on message that does not fit" testBatchWithMessageV7 + it "should break on large message" testBatchWithLargeMessageV7 describe "batchTransmissions'" $ do - describe "SMP v7 (current)" $ do - it "should batch with 109 subscriptions per batch" testClientBatchSubscriptions + describe "SMP v6 (current)" $ do + it "should batch with 107 subscriptions per batch" testClientBatchSubscriptions it "should break on message that does not fit" testClientBatchWithMessage it "should break on large message" testClientBatchWithLargeMessage - describe "v8 (next)" $ do - it "should batch with 142 subscriptions per batch" testClientBatchSubscriptionsV8 - it "should break on message that does not fit" testClientBatchWithMessageV8 - it "should break on large message" testClientBatchWithLargeMessageV8 + describe "v7 (next)" $ do + it "should batch with 136 subscriptions per batch" testClientBatchSubscriptionsV7 + it "should break on message that does not fit" testClientBatchWithMessageV7 + it "should break on large message" testClientBatchWithLargeMessageV7 testBatchSubscriptions :: IO () testBatchSubscriptions = do sessId <- atomically . C.randomBytes 32 =<< C.newRandom - subs <- replicateM 300 $ randomSUB sessId + subs <- replicateM 250 $ randomSUB sessId let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs all lenOk1 batches1 `shouldBe` True - length batches1 `shouldBe` 300 + length batches1 `shouldBe` 250 let batches = batchTransmissions True smpBlockSize $ L.fromList subs length batches `shouldBe` 3 [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _, TBTransmissions s3 n3 _] <- pure batches - (n1, n2, n3) `shouldBe` (28, 136, 136) + (n1, n2, n3) `shouldBe` (36, 107, 107) all lenOk [s1, s2, s3] `shouldBe` True -testBatchSubscriptionsV8 :: IO () -testBatchSubscriptionsV8 = do +testBatchSubscriptionsV7 :: IO () +testBatchSubscriptionsV7 = do sessId <- atomically . C.randomBytes 32 =<< C.newRandom - subs <- replicateM 300 $ randomSUBv8 sessId + subs <- replicateM 300 $ randomSUBv7 sessId let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs all lenOk1 batches1 `shouldBe` True length batches1 `shouldBe` 300 @@ -78,15 +78,15 @@ testBatchWithMessage = do let batches = batchTransmissions True smpBlockSize $ L.fromList cmds length batches `shouldBe` 2 [TBTransmissions s1 n1 _, TBTransmissions s2 n2 _] <- pure batches - (n1, n2) `shouldBe` (32, 69) + (n1, n2) `shouldBe` (47, 54) all lenOk [s1, s2] `shouldBe` True -testBatchWithMessageV8 :: IO () -testBatchWithMessageV8 = do +testBatchWithMessageV7 :: IO () +testBatchWithMessageV7 = do sessId <- atomically . C.randomBytes 32 =<< C.newRandom - subs1 <- replicateM 60 $ randomSUBv8 sessId - send <- randomSENDv8 sessId 8000 - subs2 <- replicateM 40 $ randomSUBv8 sessId + subs1 <- replicateM 60 $ randomSUBv7 sessId + send <- randomSENDv7 sessId 8000 + subs2 <- replicateM 40 $ randomSUBv7 sessId let cmds = subs1 <> [send] <> subs2 batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds all lenOk1 batches1 `shouldBe` True @@ -113,15 +113,15 @@ testBatchWithLargeMessage = do let batches = batchTransmissions True smpBlockSize $ L.fromList cmds length batches `shouldBe` 4 [TBTransmissions s1 n1 _, TBError TELargeMsg _, TBTransmissions s2 n2 _, TBTransmissions s3 n3 _] <- pure batches - (n1, n2, n3) `shouldBe` (50, 14, 136) + (n1, n2, n3) `shouldBe` (50, 43, 107) all lenOk [s1, s2, s3] `shouldBe` True -testBatchWithLargeMessageV8 :: IO () -testBatchWithLargeMessageV8 = do +testBatchWithLargeMessageV7 :: IO () +testBatchWithLargeMessageV7 = do sessId <- atomically . C.randomBytes 32 =<< C.newRandom - subs1 <- replicateM 60 $ randomSUBv8 sessId - send <- randomSENDv8 sessId 17000 - subs2 <- replicateM 150 $ randomSUBv8 sessId + subs1 <- replicateM 60 $ randomSUBv7 sessId + send <- randomSENDv7 sessId 17000 + subs2 <- replicateM 150 $ randomSUBv7 sessId let cmds = subs1 <> [send] <> subs2 batches1 = batchTransmissions False smpBlockSize $ L.fromList cmds all lenOk1 batches1 `shouldBe` False @@ -138,20 +138,20 @@ testBatchWithLargeMessageV8 = do testClientBatchSubscriptions :: IO () testClientBatchSubscriptions = do client <- testClientStub - subs <- replicateM 300 $ randomSUBCmd client + subs <- replicateM 250 $ randomSUBCmd client let batches1 = batchTransmissions' False smpBlockSize $ L.fromList subs all lenOk1 batches1 `shouldBe` True let batches = batchTransmissions' True smpBlockSize $ L.fromList subs length batches `shouldBe` 3 [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2, TBTransmissions s3 n3 rs3] <- pure batches - (n1, n2, n3) `shouldBe` (28, 136, 136) - (length rs1, length rs2, length rs3) `shouldBe` (28, 136, 136) + (n1, n2, n3) `shouldBe` (36, 107, 107) + (length rs1, length rs2, length rs3) `shouldBe` (36, 107, 107) all lenOk [s1, s2, s3] `shouldBe` True -testClientBatchSubscriptionsV8 :: IO () -testClientBatchSubscriptionsV8 = do - client <- clientStubV8 - subs <- replicateM 300 $ randomSUBCmdV8 client +testClientBatchSubscriptionsV7 :: IO () +testClientBatchSubscriptionsV7 = do + client <- clientStubV7 + subs <- replicateM 300 $ randomSUBCmdV7 client let batches1 = batchTransmissions' False smpBlockSize $ L.fromList subs all lenOk1 batches1 `shouldBe` True let batches = batchTransmissions' True smpBlockSize $ L.fromList subs @@ -174,16 +174,16 @@ testClientBatchWithMessage = do let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds length batches `shouldBe` 2 [TBTransmissions s1 n1 rs1, TBTransmissions s2 n2 rs2] <- pure batches - (n1, n2) `shouldBe` (32, 69) - (length rs1, length rs2) `shouldBe` (32, 69) + (n1, n2) `shouldBe` (47, 54) + (length rs1, length rs2) `shouldBe` (47, 54) all lenOk [s1, s2] `shouldBe` True -testClientBatchWithMessageV8 :: IO () -testClientBatchWithMessageV8 = do - client <- clientStubV8 - subs1 <- replicateM 60 $ randomSUBCmdV8 client - send <- randomSENDCmdV8 client 8000 - subs2 <- replicateM 40 $ randomSUBCmdV8 client +testClientBatchWithMessageV7 :: IO () +testClientBatchWithMessageV7 = do + client <- clientStubV7 + subs1 <- replicateM 60 $ randomSUBCmdV7 client + send <- randomSENDCmdV7 client 8000 + subs2 <- replicateM 40 $ randomSUBCmdV7 client let cmds = subs1 <> [send] <> subs2 batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds all lenOk1 batches1 `shouldBe` True @@ -212,24 +212,24 @@ testClientBatchWithLargeMessage = do let batches = batchTransmissions' True smpBlockSize $ L.fromList cmds length batches `shouldBe` 4 [TBTransmissions s1 n1 rs1, TBError TELargeMsg _, TBTransmissions s2 n2 rs2, TBTransmissions s3 n3 rs3] <- pure batches - (n1, n2, n3) `shouldBe` (50, 14, 136) - (length rs1, length rs2, length rs3) `shouldBe` (50, 14, 136) + (n1, n2, n3) `shouldBe` (50, 43, 107) + (length rs1, length rs2, length rs3) `shouldBe` (50, 43, 107) all lenOk [s1, s2, s3] `shouldBe` True -- let cmds' = [send] <> subs1 <> subs2 let batches' = batchTransmissions' True smpBlockSize $ L.fromList cmds' length batches' `shouldBe` 3 [TBError TELargeMsg _, TBTransmissions s1' n1' rs1', TBTransmissions s2' n2' rs2'] <- pure batches' - (n1', n2') `shouldBe` (64, 136) - (length rs1', length rs2') `shouldBe` (64, 136) + (n1', n2') `shouldBe` (93, 107) + (length rs1', length rs2') `shouldBe` (93, 107) all lenOk [s1', s2'] `shouldBe` True -testClientBatchWithLargeMessageV8 :: IO () -testClientBatchWithLargeMessageV8 = do - client <- clientStubV8 - subs1 <- replicateM 60 $ randomSUBCmdV8 client - send <- randomSENDCmdV8 client 17000 - subs2 <- replicateM 150 $ randomSUBCmdV8 client +testClientBatchWithLargeMessageV7 :: IO () +testClientBatchWithLargeMessageV7 = do + client <- clientStubV7 + subs1 <- replicateM 60 $ randomSUBCmdV7 client + send <- randomSENDCmdV7 client 17000 + subs2 <- replicateM 150 $ randomSUBCmdV7 client let cmds = subs1 <> [send] <> subs2 batches1 = batchTransmissions' False smpBlockSize $ L.fromList cmds all lenOk1 batches1 `shouldBe` False @@ -259,8 +259,8 @@ testClientStub = do sessId <- atomically $ C.randomBytes 32 g atomically $ clientStub g sessId currentClientSMPRelayVersion Nothing -clientStubV8 :: IO (ProtocolClient ErrorType BrokerMsg) -clientStubV8 = do +clientStubV7 :: IO (ProtocolClient ErrorType BrokerMsg) +clientStubV7 = do g <- C.newRandom sessId <- atomically $ C.randomBytes 32 g (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g @@ -270,8 +270,8 @@ clientStubV8 = do randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) randomSUB = randomSUB_ C.SEd25519 currentClientSMPRelayVersion -randomSUBv8 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) -randomSUBv8 = randomSUB_ C.SEd25519 authEncryptCmdsSMPVersion +randomSUBv7 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) +randomSUBv7 = randomSUB_ C.SEd25519 authEncryptCmdsSMPVersion randomSUB_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> Version -> ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) randomSUB_ a v sessId = do @@ -287,8 +287,8 @@ randomSUB_ a v sessId = do randomSUBCmd :: ProtocolClient ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg) randomSUBCmd = randomSUBCmd_ C.SEd25519 -randomSUBCmdV8 :: ProtocolClient ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg) -randomSUBCmdV8 = randomSUBCmd_ C.SEd25519 -- same as v7 +randomSUBCmdV7 :: ProtocolClient ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg) +randomSUBCmdV7 = randomSUBCmd_ C.SEd25519 -- same as v6 randomSUBCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg) randomSUBCmd_ a c = do @@ -300,8 +300,8 @@ randomSUBCmd_ a c = do randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) randomSEND = randomSEND_ C.SEd25519 currentClientSMPRelayVersion -randomSENDv8 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) -randomSENDv8 = randomSEND_ C.SX25519 authEncryptCmdsSMPVersion +randomSENDv7 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) +randomSENDv7 = randomSEND_ C.SX25519 authEncryptCmdsSMPVersion randomSEND_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> Version -> ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) randomSEND_ a v sessId len = do @@ -322,7 +322,7 @@ testTHandleParams v sessionId = blockSize = smpBlockSize, thVersion = v, thAuth = Nothing, - encrypt = v >= dontSendSessionIdSMPVersion, + encrypt = v >= authEncryptCmdsSMPVersion, batch = True } @@ -336,8 +336,8 @@ testTHandleAuth v g (C.APublicAuthKey a k) = case a of randomSENDCmd :: ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg) randomSENDCmd = randomSENDCmd_ C.SEd25519 -randomSENDCmdV8 :: ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg) -randomSENDCmdV8 = randomSENDCmd_ C.SX25519 +randomSENDCmdV7 :: ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg) +randomSENDCmdV7 = randomSENDCmd_ C.SX25519 randomSENDCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg) randomSENDCmd_ a c len = do diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs index c575a7640..e416c350c 100644 --- a/tests/NtfClient.hs +++ b/tests/NtfClient.hs @@ -111,8 +111,8 @@ ntfServerCfg = transportConfig = defaultTransportServerConfig } -ntfServerCfgV3 :: NtfServerConfig -ntfServerCfgV3 = +ntfServerCfgV2 :: NtfServerConfig +ntfServerCfgV2 = ntfServerCfg { ntfServerVRange = mkVersionRange 1 authEncryptCmdsNTFVersion, smpAgentCfg = defaultSMPClientAgentConfig {smpCfg = (smpCfg defaultSMPClientAgentConfig) {serverVRange = mkVersionRange 4 authEncryptCmdsSMPVersion}} @@ -151,8 +151,8 @@ ntfServerTest :: ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h where tPut' :: THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO () - tPut' h (sig, corrId, queueId, smp) = do - let t' = smpEncode (corrId, queueId, smp) + tPut' h@THandle {params = THandleParams {sessionId}} (sig, corrId, queueId, smp) = do + let t' = smpEncode (sessionId, corrId, queueId, smp) [Right ()] <- tPut h [Right (sig, t')] pure () tGet' h = do diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index f5857f23b..277c237be 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -108,8 +108,8 @@ cfg = controlPort = Nothing } -cfgV8 :: ServerConfig -cfgV8 = cfg {smpServerVRange = mkVersionRange 4 authEncryptCmdsSMPVersion} +cfgV7 :: ServerConfig +cfgV7 = cfg {smpServerVRange = mkVersionRange 4 authEncryptCmdsSMPVersion} withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile} @@ -145,8 +145,8 @@ withSmpServerOn t port' = withSmpServerThreadOn t port' . const withSmpServer :: HasCallStack => ATransport -> IO a -> IO a withSmpServer t = withSmpServerOn t testPort -withSmpServerV8 :: HasCallStack => ATransport -> IO a -> IO a -withSmpServerV8 t = withSmpServerConfigOn t cfgV8 testPort . const +withSmpServerV7 :: HasCallStack => ATransport -> IO a -> IO a +withSmpServerV7 t = withSmpServerConfigOn t cfgV7 testPort . const runSmpTest :: forall c a. (HasCallStack, Transport c) => (HasCallStack => THandle c -> IO a) -> IO a runSmpTest test = withSmpServer (transport @c) $ testSMPClient test @@ -170,8 +170,8 @@ smpServerTest :: smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h where tPut' :: THandle c -> (Maybe TransmissionAuth, ByteString, ByteString, smp) -> IO () - tPut' h (sig, corrId, queueId, smp) = do - let t' = smpEncode (corrId, queueId, smp) + tPut' h@THandle {params = THandleParams {sessionId}} (sig, corrId, queueId, smp) = do + let t' = smpEncode (sessionId,corrId, queueId, smp) [Right ()] <- tPut h [Right (sig, t')] pure () tGet' h = do diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 3cb2ea57a..6043ec023 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -745,7 +745,7 @@ testTiming (ATransport t) = describe "should have similar time for auth error, whether queue exists or not, for all key types" $ forM_ timingTests $ \tst -> it (testName tst) $ - smpTest2Cfg cfgV8 (mkVersionRange 4 authEncryptCmdsSMPVersion) t $ \rh sh -> + smpTest2Cfg cfgV7 (mkVersionRange 4 authEncryptCmdsSMPVersion) t $ \rh sh -> testSameTiming rh sh tst where testName :: (C.AuthAlg, C.AuthAlg, Int) -> String