mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-05-13 18:43:11 +00:00
remove v8, merge all changes to one version
This commit is contained in:
Evgeny Poberezkin
@@ -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)},
|
||||
|
||||
@@ -155,7 +155,7 @@ clientStub g sessionId thVersion thAuth = do
|
||||
thVersion,
|
||||
thAuth,
|
||||
blockSize = smpBlockSize,
|
||||
encrypt = thVersion >= dontSendSessionIdSMPVersion,
|
||||
encrypt = thVersion >= authEncryptCmdsSMPVersion,
|
||||
batch = True
|
||||
},
|
||||
sessionTs = undefined,
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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
|
||||
|
||||
+4
-4
@@ -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
|
||||
|
||||
+6
-6
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user